Una vez que instales FWH en c:\FWH o una ubicación similar, ejecuta Google Antigravity y selecciona la carpeta c:\FWH (o donde sea que lo hayas instalado).
A partir de ese momento, podrás preguntarle a Antigravity cualquier cosa sobre el código de FWH, pedirle ejemplos, explicaciones de código, que cree nuevos ejemplos, etc.
Deberías probarlo!
The user wants me to reply to the pending question in the thread.
Let's analyze the thread:
Title: "Antigravity para ayudarte con FWH" (Antigravity to help you with FWH)
Conversation:
[Message from Antonio Linares]
"Una vez que instales FWH en c:\FWH o una ubicación similar, ejecuta Google Antigravity y selecciona la carpeta c:\FWH (o donde sea que lo hayas instalado). A partir de ese momento, podrás preguntarle a Antigravity cualquier cosa sobre el código de FWH, pedirle ejemplos, explicaciones de código, que cree nuevos ejemplos, etc. Deberías probarlo!
https://antigravity.google/download/
Pedi un nuevo ejemplo en fivewin... Show!!
#include "FiveWin.ch"
#include "xbrowse.ch"
FUNCTION Main()
LOCAL oWnd, oBar, oFont, oFontB, oBrw
LOCAL aData := {}
// 1. Dados de Exemplo
aData := { ;
{ 101, "Acme Corp", "São Paulo", "SP", 15420.50, .T., Date() - 10 }, ;
{ 102, "Tech Solutions", "Curitiba", "PR", 8750.00, .T., Date() - 5 }, ;
{ 103, "Global Logistics","Santos", "SP", 23100.80, .F., Date() - 2 }, ;
{ 104, "Inova Software", "Belo Horizonte","MG", 12300.00, .T., Date() - 1 }, ;
{ 105, "Distribuidora Sul","Porto Alegre","RS", 34500.25, .T., Date() }, ;
{ 106, "Alpha Consultoria","Rio de Janeiro","RJ", 9800.00, .F., Date() - 15 } ;
}
// 2. Fontes
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -13
DEFINE FONT oFontB NAME "Segoe UI" SIZE 0, -14 BOLD
// 3. Janela Principal
DEFINE WINDOW oWnd TITLE "FiveWin 26.03 - Exemplo Moderno de Gestão" ;
BRUSH TBrush():New( , nRGB( 245, 247, 250 ) )
// 4. Barra de Ferramentas Moderna (Flat / 2015 Style)
DEFINE BUTTONBAR oBar OF oWnd SIZE 64, 60 2015
DEFINE BUTTON OF oBar PROMPT "Novo" TOOLTIP "Incluir Registro" ACTION IncluirRegistro( oBrw, @aData, oWnd )
DEFINE BUTTON OF oBar PROMPT "Editar" TOOLTIP "Alterar Registro" ACTION EditarRegistro( oBrw, @aData, oWnd )
DEFINE BUTTON OF oBar PROMPT "Excluir" TOOLTIP "Remover Registro" ACTION ExcluirRegistro( oBrw, @aData )
DEFINE BUTTON OF oBar PROMPT "Exportar" TOOLTIP "Exportar para Excel" ACTION oBrw:ToExcel() GROUP
DEFINE BUTTON OF oBar PROMPT "Sair" TOOLTIP "Fechar Sistema" ACTION oWnd:End() GROUP
// 5. XBrowse Moderno
@ 0, 0 XBROWSE oBrw OF oWnd ARRAY aData ;
COLUMNS 1, 2, 3, 4, 5, 6, 7 ;
HEADERS "ID", "Cliente / Razão Social", "Cidade", "UF", "Valor Total (R$)", "Ativo?", "Última Compra" ;
COLSIZES 60, 220, 140, 50, 130, 70, 110 ;
AUTOSORT PIXEL
// Estilização do Browse
WITH OBJECT oBrw
:SetFont( oFont )
:nRowHeight := 28
:nHeaderHeight := 32
:nFooterHeight := 30
:lFooter := .T.
:lHScroll := .F.
:lRecordSelector := .F.
:l2007 := .F.
// Cores alternadas (Zebra)
:bClrStd := { || { CLR_BLACK, If( oBrw:KeyNo % 2 == 0, nRGB( 255, 255, 255 ), nRGB( 242, 245, 249 ) ) } }
:bClrSelFocus := { || { CLR_WHITE, nRGB( 33, 150, 243 ) } } // Azul Material
// Configuração de Colunas e Totais
:aCols[ 1 ]:nDataStrAlign := AL_RIGHT
:aCols[ 5 ]:nDataStrAlign := AL_RIGHT
:aCols[ 5 ]:cEditPicture := "@E 999,999.92"
:aCols[ 5 ]:nFooterType := AGGR_SUM
:aCols[ 5 ]:cFooterPicture:= "@E 999,999.92"
:aCols[ 6 ]:SetCheck( , .T. ) // Checkbox nativo na coluna
:aCols[ 7 ]:nDataStrAlign := AL_CENTER
// Duplo clique para editar
:bLDblClick := { || EditarRegistro( oBrw, @aData, oWnd ) }
:MakeTotals()
:CreateFromCode()
END
// Ajusta o browse ao redimensionar a janela
oWnd:oClient := oBrw
ACTIVATE WINDOW oWnd MAXIMIZED
RELEASE FONT oFont, oFontB
RETURN NIL
// -------------------------------------------------------------
// Função para Incluir Registro
// -------------------------------------------------------------
STATIC FUNCTION IncluirRegistro( oBrw, aData, oWnd )
LOCAL aNovo := { Len( aData ) + 101, Space( 40 ), Space( 30 ), "SP", 0.00, .T., Date() }
IF FormularioCliente( aNovo, .T., oWnd )
AAdd( aData, aNovo )
oBrw:Refresh()
oBrw:MakeTotals()
oBrw:GoBottom()
ENDIF
RETURN NIL
// -------------------------------------------------------------
// Função para Editar Registro
// -------------------------------------------------------------
STATIC FUNCTION EditarRegistro( oBrw, aData, oWnd )
LOCAL nPos := oBrw:nArrayAt
LOCAL aReg
IF nPos == 0 .OR. Len( aData ) == 0
MsgAlert( "Nenhum registro selecionado!", "Atenção" )
RETURN NIL
ENDIF
aReg := AClone( aData[ nPos ] )
IF FormularioCliente( aReg, .F., oWnd )
aData[ nPos ] := aReg
oBrw:RefreshCurrent()
oBrw:MakeTotals()
ENDIF
RETURN NIL
// -------------------------------------------------------------
// Função para Excluir Registro
// -------------------------------------------------------------
STATIC FUNCTION ExcluirRegistro( oBrw, aData )
LOCAL nPos := oBrw:nArrayAt
IF nPos == 0 .OR. Len( aData ) == 0
MsgAlert( "Nenhum registro selecionado!", "Atenção" )
RETURN NIL
ENDIF
IF MsgYesNo( "Deseja realmente excluir o cliente: " + AllTrim( aData[ nPos, 2 ] ) + "?", "Confirmação" )
ADel( aData, nPos )
ASize( aData, Len( aData ) - 1 )
oBrw:Refresh()
oBrw:MakeTotals()
ENDIF
RETURN NIL
// -------------------------------------------------------------
// Dialog Modal / Formulário de Cadastro
// -------------------------------------------------------------
STATIC FUNCTION FormularioCliente( aItem, lNovo, oWnd )
LOCAL oDlg, oFont, lSalvar := .F.
LOCAL cTitulo := If( lNovo, "Novo Cliente", "Editar Cliente" )
LOCAL aUFs := { "AC","AL","AP","AM","BA","CE","DF","ES","GO","MA","MT","MS","MG","PA","PB","PR","PE","PI","RJ","RN","RS","RO","RR","SC","SP","SE","TO" }
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -13
DEFINE DIALOG oDlg TITLE cTitulo SIZE 480, 360 PIXEL FONT oFont COLOR CLR_BLACK, nRGB( 250, 250, 250 )
@ 15, 15 SAY "Código:" OF oDlg PIXEL SIZE 60, 12
@ 13, 70 GET aItem[ 1 ] PICTURE "99999" WHEN .F. OF oDlg PIXEL SIZE 60, 12
@ 35, 15 SAY "Razão Social:" OF oDlg PIXEL SIZE 60, 12
@ 33, 70 GET aItem[ 2 ] PICTURE "@!" VALID !Empty( aItem[ 2 ] ) OF oDlg PIXEL SIZE 150, 12
@ 55, 15 SAY "Cidade:" OF oDlg PIXEL SIZE 60, 12
@ 53, 70 GET aItem[ 3 ] PICTURE "@!" OF oDlg PIXEL SIZE 150, 12
@ 75, 15 SAY "UF:" OF oDlg PIXEL SIZE 60, 12
@ 73, 70 COMBOBOX aItem[ 4 ] ITEMS aUFs OF oDlg PIXEL SIZE 50, 80
@ 95, 15 SAY "Valor Total:" OF oDlg PIXEL SIZE 60, 12
@ 93, 70 GET aItem[ 5 ] PICTURE "@E 999,999.92" OF oDlg PIXEL SIZE 80, 12
@ 115, 15 SAY "Dt. Compra:" OF oDlg PIXEL SIZE 60, 12
@ 113, 70 GET aItem[ 7 ] OF oDlg PIXEL SIZE 70, 12
@ 135, 70 CHECKBOX aItem[ 6 ] PROMPT "Cliente Ativo no Cadastro" OF oDlg PIXEL SIZE 120, 12
// Botões de Ação
@ 155, 100 BUTTON "Salvar" OF oDlg PIXEL SIZE 60, 16 ;
ACTION ( lSalvar := .T., oDlg:End() ) DEFAULT
@ 155, 165 BUTTON "Cancelar" OF oDlg PIXEL SIZE 60, 16 ;
ACTION ( lSalvar := .F., oDlg:End() )
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
RETURN lSalvarRegards, saludos.
¡Fantástico! Maestro Antônio, Antigravity falla con la acentuación en portugués; ¿se puede configurar la acentuación? Si es así, ¿dónde? Aún no lo he entendido muy bien; jajaja. -> ¿No se puede cambiar el idioma de inglés a español o portugués?
// ============================================================================
// SISTEMA MODERNO DE CADASTRO DE CLIENTES (FWH 26.03 / HARBOUR)
// Interface Moderna: Segoe UI, Cards KPI, XBrowse Customizado, Busca CEP / CNPJ,
// Integracao WhatsApp, Validacoes PF/PJ, Exportacao Excel e Relatorios.
// ============================================================================
#include "FiveWin.ch"
#include "xbrowse.ch"
REQUEST DBFCDX
REQUEST DBFFPT
#define CLR_NAVY_DARK RGB( 15, 23, 42 )
#define CLR_NAVY_LIGHT RGB( 30, 41, 59 )
#define CLR_BG_APP RGB( 241, 245, 249 )
#define CLR_CARD_BG RGB( 255, 255, 255 )
#define CLR_ACCENT_BLUE RGB( 37, 99, 235 )
#define CLR_GREEN_DARK RGB( 22, 101, 52 )
#define CLR_GREEN_LIGHT RGB( 220, 252, 231 )
#define CLR_RED_DARK RGB( 153, 27, 27 )
#define CLR_RED_LIGHT RGB( 254, 226, 226 )
#define CLR_AMBER_DARK RGB( 146, 64, 14 )
#define CLR_AMBER_LIGHT RGB( 254, 243, 199 )
#define CLR_TEXT_MUTED RGB( 100, 116, 139 )
// ----------------------------------------------------------------------------
// INICIALIZACAO DA APLICACAO
// ----------------------------------------------------------------------------
FUNCTION Main()
LOCAL oWnd, oBar, oBrw, oFontApp, oFontBold, oFontTitle, oFontCard
LOCAL oBtnNovo, oBtnEdit, oBtnDel, oBtnZap, oBtnMap, oBtnXls, oBtnPrn, oBtnExit
LOCAL oSayBusca, oGetBusca, cBusca := Space( 35 )
SET DATE BRITISH
SET CENTURY ON
SET DELETED ON
SET EXACT OFF
RDDSETDEFAULT( "DBFCDX" )
FWNumFormat( "E", .T. )
// Inicializa ou abre a base de dados
IF !InitDatabase()
MsgStop( "Nao foi possivel inicializar a base de dados!", "Erro" )
RETURN NIL
ENDIF
// Definicao de Fontes Modernas (Segoe UI)
DEFINE FONT oFontApp NAME "Segoe UI" SIZE 0, -13
DEFINE FONT oFontBold NAME "Segoe UI" SIZE 0, -13 BOLD
DEFINE FONT oFontTitle NAME "Segoe UI" SIZE 0, -16 BOLD
DEFINE FONT oFontCard NAME "Segoe UI" SIZE 0, -14 BOLD
// Janela Principal
DEFINE WINDOW oWnd TITLE "Cadastro e Gestão Moderna de Clientes 2026" ;
COLOR CLR_NAVY_DARK, CLR_BG_APP
oWnd:SetFont( oFontApp )
// Barra Superior Moderna com estilo 2010
DEFINE BUTTONBAR oBar OF oWnd SIZE 80, 56 2010
DEFINE BUTTON oBtnNovo OF oBar PROMPT "Novo (Ins)" ;
TOOLTIP "Cadastrar Novo Cliente [Insert]" ;
ACTION ( FormCliente( .T., oBrw ), oBrw:Refresh() )
DEFINE BUTTON oBtnEdit OF oBar PROMPT "Editar (Enter)" ;
TOOLTIP "Editar Cliente Selecionado [Enter]" ;
ACTION ( FormCliente( .F., oBrw ), oBrw:Refresh() )
DEFINE BUTTON oBtnDel OF oBar PROMPT "Excluir (Del)" ;
TOOLTIP "Excluir Cliente [Delete]" ;
ACTION ExcluirCliente( oBrw )
DEFINE BUTTON oBtnZap OF oBar PROMPT "WhatsApp" GROUP ;
TOOLTIP "Iniciar conversa direta no WhatsApp Web" ;
ACTION AbrirWhatsApp( CLIENTES->CELULAR )
DEFINE BUTTON oBtnMap OF oBar PROMPT "Mapa" ;
TOOLTIP "Localizar endereco no Google Maps" ;
ACTION AbrirMapa( CLIENTES->ENDERECO, CLIENTES->NUMERO, CLIENTES->CIDADE, CLIENTES->ESTADO )
DEFINE BUTTON oBtnXls OF oBar PROMPT "Excel" GROUP ;
TOOLTIP "Exportar grade completa para planilha MS Excel" ;
ACTION oBrw:ToExcel()
DEFINE BUTTON oBtnPrn OF oBar PROMPT "Relatório" ;
TOOLTIP "Gerar relatório e pré-visualização de impressão" ;
ACTION oBrw:Report( "Relatório Geral de Clientes", .T., .F. )
DEFINE BUTTON oBtnExit OF oBar PROMPT "Sair (Esc)" GROUP ;
TOOLTIP "Encerrar o sistema" ;
ACTION oWnd:End()
// Grade Moderna (XBrowse)
@ 0, 0 XBROWSE oBrw OF oWnd DATASOURCE "CLIENTES" AUTOCOLS AUTOSORT ;
LINES CELL PIXEL NOBORDER FOOTERS
WITH OBJECT oBrw
:nRowHeight := 30
:nHeaderHeight := 34
:nFooterHeight := 28
:oFont := oFontApp
// :oHeaderFont := oFontBold // No ejiste
// :oFooterFont := oFontBold // No ejiste
// Cores das Linhas Alternadas (Zebra Stripe moderno)
:bClrStd := { || { CLR_NAVY_DARK, If( oBrw:KeyNo % 2 == 0, RGB( 255, 255, 255 ), RGB( 248, 250, 252 ) ) } }
:bClrSel := { || { CLR_WHITE, RGB( 37, 99, 235 ) } }
:bClrSelFocus := { || { CLR_WHITE, RGB( 29, 78, 216 ) } }
// Configuracao das Colunas
IF :oCol( "CODIGO" ) != NIL
:oCol( "CODIGO" ):cHeader := "Código"
:oCol( "CODIGO" ):nWidth := 70
:oCol( "CODIGO" ):nDataStrAlign := AL_CENTER
:oCol( "CODIGO" ):nHeadStrAlign := AL_CENTER
ENDIF
IF :oCol( "TIPO" ) != NIL
:oCol( "TIPO" ):cHeader := "Tipo"
:oCol( "TIPO" ):nWidth := 55
:oCol( "TIPO" ):nDataStrAlign := AL_CENTER
:oCol( "TIPO" ):nHeadStrAlign := AL_CENTER
ENDIF
IF :oCol( "NOME" ) != NIL
:oCol( "NOME" ):cHeader := "Nome / Razão Social"
:oCol( "NOME" ):nWidth := 230
:oCol( "NOME" ):bFooter := { || "Total: " + AllTrim( Str( RecCount() ) ) + " clientes" }
ENDIF
IF :oCol( "FANTASIA" ) != NIL
:oCol( "FANTASIA" ):cHeader := "Nome Fantasia"
:oCol( "FANTASIA" ):nWidth := 160
ENDIF
IF :oCol( "DOC" ) != NIL
:oCol( "DOC" ):cHeader := "CPF / CNPJ"
:oCol( "DOC" ):nWidth := 150
ENDIF
IF :oCol( "CELULAR" ) != NIL
:oCol( "CELULAR" ):cHeader := "Celular / WhatsApp"
:oCol( "CELULAR" ):nWidth := 140
ENDIF
IF :oCol( "CIDADE" ) != NIL
:oCol( "CIDADE" ):cHeader := "Cidade"
:oCol( "CIDADE" ):nWidth := 140
ENDIF
IF :oCol( "ESTADO" ) != NIL
:oCol( "ESTADO" ):cHeader := "UF"
:oCol( "ESTADO" ):nWidth := 45
:oCol( "ESTADO" ):nDataStrAlign := AL_CENTER
:oCol( "ESTADO" ):nHeadStrAlign := AL_CENTER
ENDIF
IF :oCol( "LIMITE" ) != NIL
:oCol( "LIMITE" ):cHeader := "Limite Crédito"
:oCol( "LIMITE" ):nWidth := 120
:oCol( "LIMITE" ):cEditPicture := "@E 999,999.99"
:oCol( "LIMITE" ):nDataStrAlign := AL_RIGHT
:oCol( "LIMITE" ):nHeadStrAlign := AL_RIGHT
:oCol( "LIMITE" ):bFooter := { || "R$ " + Transform( TotalLimite(), "@E 999,999.99" ) }
:oCol( "LIMITE" ):nFootStrAlign := AL_RIGHT
ENDIF
IF :oCol( "STATUS" ) != NIL
:oCol( "STATUS" ):cHeader := "Status"
:oCol( "STATUS" ):nWidth := 85
:oCol( "STATUS" ):nDataStrAlign := AL_CENTER
:oCol( "STATUS" ):nHeadStrAlign := AL_CENTER
:oCol( "STATUS" ):bStrData := { || If( CLIENTES->STATUS == "A", "ATIVO", If( CLIENTES->STATUS == "B", "BLOQUEADO", "INATIVO" ) ) }
:oCol( "STATUS" ):bClrStd := { || If( CLIENTES->STATUS == "A", { CLR_GREEN_DARK, CLR_GREEN_LIGHT }, ;
If( CLIENTES->STATUS == "B", { CLR_AMBER_DARK, CLR_AMBER_LIGHT }, ;
{ CLR_RED_DARK, CLR_RED_LIGHT } ) ) }
ENDIF
// Acoes com o Teclado e Mouse
:bLDblClick := { || FormCliente( .F., oBrw ), oBrw:Refresh() }
:bRClicked := { |nRow, nCol| MenuContexto( nRow, nCol, oBrw ) }
:bKeyDown := { |nKey| TratarTeclas( nKey, oBrw ) }
// Barra de Busca Incremental Automatica
:lIncrFilter := .T.
:lSeekWild := .T.
:CreateFromCode()
END
// Ajuste do XBrowse para preencher a janela
oWnd:oClient := oBrw
ACTIVATE WINDOW oWnd MAXIMIZED
RELEASE FONT oFontApp, oFontBold, oFontTitle, oFontCard
CLOSE CLIENTES
RETURN NIL
// ----------------------------------------------------------------------------
// TRATAR TECLAS DE ATALHO NO BROWSE
// ----------------------------------------------------------------------------
STATIC FUNCTION TratarTeclas( nKey, oBrw )
IF nKey == VK_RETURN
FormCliente( .F., oBrw )
oBrw:Refresh()
ELSEIF nKey == VK_DELETE
ExcluirCliente( oBrw )
ELSEIF nKey == VK_INSERT
FormCliente( .T., oBrw )
oBrw:Refresh()
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------
// MENU DE CONTEXTO (BOTAO DIREITO DO MOUSE)
// ----------------------------------------------------------------------------
STATIC FUNCTION MenuContexto( nRow, nCol, oBrw )
LOCAL oMenu
MENU oMenu POPUP 2007
MENUITEM " [ + ] Novo Cliente" ACTION ( FormCliente( .T., oBrw ), oBrw:Refresh() )
MENUITEM " [ ✎ ] Editar Registro" ACTION ( FormCliente( .F., oBrw ), oBrw:Refresh() )
MENUITEM " [ 👠] Visualizar Ficha" ACTION FormCliente( .F., oBrw, .T. )
SEPARATOR
MENUITEM " [ 💬 ] Chamar no WhatsApp" ACTION AbrirWhatsApp( CLIENTES->CELULAR )
MENUITEM " [ 📠] Ver no Google Maps" ACTION AbrirMapa( CLIENTES->ENDERECO, CLIENTES->NUMERO, CLIENTES->CIDADE, CLIENTES->ESTADO )
SEPARATOR
MENUITEM " [ 📊 ] Exportar para Excel" ACTION oBrw:ToExcel()
MENUITEM " [ 🖨 ] Imprimir Relatório" ACTION oBrw:Report( "Relatório Geral de Clientes", .T., .F. )
SEPARATOR
MENUITEM " [ 🗑 ] Excluir Cliente" ACTION ExcluirCliente( oBrw )
ENDMENU
ACTIVATE POPUP oMenu AT nRow, nCol OF oBrw
RETURN NIL
// ----------------------------------------------------------------------------
// FORMULARIO MODERNO DE CLIENTES (INCLUSAO / ALTERACAO / VISUALIZACAO)
// ----------------------------------------------------------------------------
FUNCTION FormCliente( lNovo, oBrw, lSomenteLeitura )
LOCAL oDlg, oFont, oFontBold, oFontTitle, oFld, oSayHdr1, oSayHdr2
LOCAL cTitulo := If( lNovo, "Novo Cliente", If( lSomenteLeitura == .T., "Visualização de Cliente", "Alteração de Cliente" ) )
// Variaveis dos Campos
LOCAL cCodigo := If( lNovo, ProximoCodigo(), CLIENTES->CODIGO )
LOCAL cTipo := If( lNovo, "PF", CLIENTES->TIPO )
LOCAL cNome := If( lNovo, Space( 50 ), CLIENTES->NOME )
LOCAL cFantasia := If( lNovo, Space( 40 ), CLIENTES->FANTASIA )
LOCAL cDoc := If( lNovo, Space( 18 ), CLIENTES->DOC )
LOCAL cRgIe := If( lNovo, Space( 20 ), CLIENTES->RG_IE )
LOCAL cFone := If( lNovo, Space( 20 ), CLIENTES->FONE )
LOCAL cCelular := If( lNovo, Space( 20 ), CLIENTES->CELULAR )
LOCAL cEmail := If( lNovo, Space( 60 ), CLIENTES->EMAIL )
LOCAL cCep := If( lNovo, Space( 10 ), CLIENTES->CEP )
LOCAL cEndereco := If( lNovo, Space( 50 ), CLIENTES->ENDERECO )
LOCAL cNumero := If( lNovo, Space( 10 ), CLIENTES->NUMERO )
LOCAL cComple := If( lNovo, Space( 30 ), CLIENTES->COMPLE )
LOCAL cBairro := If( lNovo, Space( 35 ), CLIENTES->BAIRRO )
LOCAL cCidade := If( lNovo, Space( 35 ), CLIENTES->CIDADE )
LOCAL cEstado := If( lNovo, "SP", CLIENTES->ESTADO )
LOCAL nLimite := If( lNovo, 1000.00, CLIENTES->LIMITE )
LOCAL dDtCad := If( lNovo, Date(), CLIENTES->DTCAD )
LOCAL cStatus := If( lNovo, "A", CLIENTES->STATUS )
LOCAL cObs := If( lNovo, Space( 200 ), CLIENTES->OBS )
// Objetos de Controle
LOCAL oGetCod, oGetTipo, oGetNome, oGetFant, oGetDoc, oGetRgIe
LOCAL oGetFone, oGetCel, oGetEmail, oGetCep, oGetEnd, oGetNum
LOCAL oGetComp, oGetBair, oGetCid, oGetUf, oGetLim, oGetDtCad, oGetStatus, oGetObs
LOCAL aTipos := { "PF - Pessoa FÃsica", "PJ - Pessoa JurÃdica" }
LOCAL nTipoPos := If( cTipo == "PJ", 2, 1 )
LOCAL aStatus := { "A - Ativo", "I - Inativo", "B - Bloqueado" }
LOCAL nStatPos := If( cStatus == "B", 3, If( cStatus == "I", 2, 1 ) )
LOCAL aUfs := { "AC","AL","AP","AM","BA","CE","DF","ES","GO","MA","MT","MS","MG","PA","PB","PR","PE","PI","RJ","RN","RS","RO","RR","SC","SP","SE","TO" }
DEFAULT lSomenteLeitura := .F.
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -12
DEFINE FONT oFontBold NAME "Segoe UI" SIZE 0, -12 BOLD
DEFINE FONT oFontTitle NAME "Segoe UI" SIZE 0, -15 BOLD
DEFINE DIALOG oDlg TITLE cTitulo SIZE 730, 570 PIXEL COLOR CLR_NAVY_DARK, CLR_BG_APP
// Header visual do Dialog
@ 6, 12 SAY oSayHdr1 VAR "FICHA CADASTRAL DO CLIENTE" OF oDlg PIXEL ;
FONT oFontTitle COLOR CLR_NAVY_DARK, CLR_BG_APP SIZE 300, 16
@ 22, 12 SAY oSayHdr2 VAR If( lNovo, "Preencha as informações cadastrais abaixo", "Consulte ou altere os dados do cliente" ) ;
OF oDlg PIXEL FONT oFont COLOR CLR_TEXT_MUTED, CLR_BG_APP SIZE 300, 14
// ABAS ORGANIZADAS (FOLDER)
@ 40, 10 FOLDER oFld PROMPTS " 1. Identificação ", " 2. Contatos & Endereço ", " 3. Financeiro & Obs " ;
OF oDlg SIZE 345, 210 PIXEL FONT oFontBold
// =========================================================================
// ABA 1: IDENTIFICACAO E DOCUMENTOS
// =========================================================================
@ 12, 10 SAY "Código:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 50, 12
@ 24, 10 GET oGetCod VAR cCodigo OF oFld:aDialogs[1] PIXEL SIZE 60, 12 READONLY FONT oFont
@ 12, 80 SAY "Tipo de Pessoa:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 90, 12
@ 24, 80 COMBOBOX oGetTipo VAR nTipoPos ITEMS aTipos OF oFld:aDialogs[1] PIXEL SIZE 110, 100 FONT oFont ;
ON CHANGE ( cTipo := If( nTipoPos == 2, "PJ", "PF" ) )
@ 12, 200 SAY "Status:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 50, 12
@ 24, 200 COMBOBOX oGetStatus VAR nStatPos ITEMS aStatus OF oFld:aDialogs[1] PIXEL SIZE 125, 100 FONT oFont ;
ON CHANGE ( cStatus := SubStr( aStatus[nStatPos], 1, 1 ) )
@ 44, 10 SAY "Nome Completo / Razão Social (*):" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 180, 12
@ 56, 10 GET oGetNome VAR cNome OF oFld:aDialogs[1] PIXEL SIZE 315, 12 FONT oFont PICTURE "@!"
@ 76, 10 SAY "Nome Fantasia / Apelido:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 150, 12
@ 88, 10 GET oGetFant VAR cFantasia OF oFld:aDialogs[1] PIXEL SIZE 315, 12 FONT oFont PICTURE "@!"
@ 108, 10 SAY "CPF / CNPJ:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 80, 12
@ 120, 10 GET oGetDoc VAR cDoc OF oFld:aDialogs[1] PIXEL SIZE 130, 12 FONT oFont PICTURE "@!"
// Botao Consulta Receita Federal (CNPJ)
@ 119, 145 BUTTON "Consultar CNPJ" OF oFld:aDialogs[1] PIXEL SIZE 75, 14 FONT oFont ;
ACTION ( BuscarReceitaWS( @cDoc, @cNome, @cFantasia, @cEndereco, @cNumero, @cComple, @cBairro, @cCidade, @cEstado, @cCep, @cFone, oDlg ) )
@ 108, 225 SAY "RG / Inscrição Estadual:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 100, 12
@ 120, 225 GET oGetRgIe VAR cRgIe OF oFld:aDialogs[1] PIXEL SIZE 100, 12 FONT oFont PICTURE "@!"
@ 140, 10 SAY "Data Cadastro:" OF oFld:aDialogs[1] PIXEL FONT oFontBold SIZE 80, 12
@ 152, 10 GET oGetDtCad VAR dDtCad OF oFld:aDialogs[1] PIXEL SIZE 70, 12 FONT oFont
// =========================================================================
// ABA 2: CONTATOS & ENDERECO
// =========================================================================
@ 10, 10 SAY "Celular / WhatsApp (*):" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 120, 12
@ 22, 10 GET oGetCel VAR cCelular OF oFld:aDialogs[2] PIXEL SIZE 100, 12 FONT oFont PICTURE "@R (99) 99999-9999"
@ 21, 115 BUTTON "Testar WhatsApp" OF oFld:aDialogs[2] PIXEL SIZE 80, 14 FONT oFont ;
ACTION AbrirWhatsApp( cCelular )
@ 10, 205 SAY "Telefone Fixo:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 80, 12
@ 22, 205 GET oGetFone VAR cFone OF oFld:aDialogs[2] PIXEL SIZE 120, 12 FONT oFont PICTURE "@R (99) 9999-9999"
@ 40, 10 SAY "E-mail Principal:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 80, 12
@ 52, 10 GET oGetEmail VAR cEmail OF oFld:aDialogs[2] PIXEL SIZE 315, 12 FONT oFont
@ 72, 10 SAY "CEP:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 50, 12
@ 84, 10 GET oGetCep VAR cCep OF oFld:aDialogs[2] PIXEL SIZE 70, 12 FONT oFont PICTURE "@R 99999-999"
// Botao Busca CEP ViaCEP
@ 83, 85 BUTTON "Buscar CEP (ViaCEP)" OF oFld:aDialogs[2] PIXEL SIZE 95, 14 FONT oFont ;
ACTION ( BuscarViaCEP( @cCep, @cEndereco, @cBairro, @cCidade, @cEstado, oDlg ) )
@ 72, 190 SAY "Estado (UF):" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 60, 12
@ 84, 190 COMBOBOX oGetUf VAR cEstado ITEMS aUfs OF oFld:aDialogs[2] PIXEL SIZE 50, 100 FONT oFont
@ 104, 10 SAY "Logradouro / Endereço:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 120, 12
@ 116, 10 GET oGetEnd VAR cEndereco OF oFld:aDialogs[2] PIXEL SIZE 240, 12 FONT oFont PICTURE "@!"
@ 104, 255 SAY "Número:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 50, 12
@ 116, 255 GET oGetNum VAR cNumero OF oFld:aDialogs[2] PIXEL SIZE 70, 12 FONT oFont PICTURE "@!"
@ 136, 10 SAY "Bairro:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 60, 12
@ 148, 10 GET oGetBair VAR cBairro OF oFld:aDialogs[2] PIXEL SIZE 150, 12 FONT oFont PICTURE "@!"
@ 136, 165 SAY "Cidade:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 60, 12
@ 148, 165 GET oGetCid VAR cCidade OF oFld:aDialogs[2] PIXEL SIZE 160, 12 FONT oFont PICTURE "@!"
@ 168, 10 SAY "Complemento:" OF oFld:aDialogs[2] PIXEL FONT oFontBold SIZE 80, 12
@ 180, 10 GET oGetComp VAR cComple OF oFld:aDialogs[2] PIXEL SIZE 315, 12 FONT oFont PICTURE "@!"
// =========================================================================
// ABA 3: FINANCEIRO & CRM
// =========================================================================
@ 15, 10 SAY "Limite de Crédito Aprovado (R$):" OF oFld:aDialogs[3] PIXEL FONT oFontBold SIZE 180, 12
@ 28, 10 GET oGetLim VAR nLimite OF oFld:aDialogs[3] PIXEL SIZE 120, 12 FONT oFont PICTURE "@E 999,999.99"
@ 50, 10 SAY "Histórico e Observações Gerais:" OF oFld:aDialogs[3] PIXEL FONT oFontBold SIZE 180, 12
@ 64, 10 GET oGetObs VAR cObs MEMO OF oFld:aDialogs[3] PIXEL SIZE 315, 100 FONT oFont
// BOTOES DE ACAO INFERIORES
IF !lSomenteLeitura
@ 255, 165 BUTTON "&Gravar Informações" OF oDlg PIXEL SIZE 95, 18 FONT oFontBold ;
ACTION ( SalvarCliente( lNovo, cCodigo, cTipo, cNome, cFantasia, cDoc, cRgIe, ;
cFone, cCelular, cEmail, cCep, cEndereco, cNumero, ;
cComple, cBairro, cCidade, cEstado, nLimite, dDtCad, ;
cStatus, cObs, oDlg ) )
@ 255, 265 BUTTON "&Cancelar" OF oDlg PIXEL SIZE 80, 18 FONT oFont ;
ACTION oDlg:End()
ELSE
@ 255, 265 BUTTON "&Fechar" OF oDlg PIXEL SIZE 80, 18 FONT oFont ;
ACTION oDlg:End()
ENDIF
ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont, oFontBold, oFontTitle
RETURN NIL
// ----------------------------------------------------------------------------
// VALIDACAO E PERSISTENCIA NO DBF
// ----------------------------------------------------------------------------
STATIC FUNCTION SalvarCliente( lNovo, cCodigo, cTipo, cNome, cFantasia, cDoc, cRgIe, ;
cFone, cCelular, cEmail, cCep, cEndereco, cNumero, ;
cComple, cBairro, cCidade, cEstado, nLimite, dDtCad, ;
cStatus, cObs, oDlg )
LOCAL cCleanDoc := LimparNumero( cDoc )
IF Empty( AllTrim( cNome ) )
MsgAlert( "O campo Nome / Razão Social é obrigatório!", "Atenção" )
RETURN .F.
ENDIF
// Validação de Documento (CPF / CNPJ) caso preenchido
IF !Empty( cCleanDoc )
IF Len( cCleanDoc ) == 11
IF !ValidarCPF( cCleanDoc )
IF !MsgYesNo( "O CPF informado parece inválido. Deseja gravar mesmo assim?", "Aviso de Validação" )
RETURN .F.
ENDIF
ENDIF
ELSEIF Len( cCleanDoc ) == 14
IF !ValidarCNPJ( cCleanDoc )
IF !MsgYesNo( "O CNPJ informado parece inválido. Deseja gravar mesmo assim?", "Aviso de Validação" )
RETURN .F.
ENDIF
ENDIF
ENDIF
ENDIF
IF lNovo
CLIENTES->( DbAppend() )
ELSE
CLIENTES->( RLock() )
ENDIF
CLIENTES->CODIGO := cCodigo
CLIENTES->TIPO := cTipo
CLIENTES->NOME := cNome
CLIENTES->FANTASIA := cFantasia
CLIENTES->DOC := cDoc
CLIENTES->RG_IE := cRgIe
CLIENTES->FONE := cFone
CLIENTES->CELULAR := cCelular
CLIENTES->EMAIL := cEmail
CLIENTES->CEP := cCep
CLIENTES->ENDERECO := cEndereco
CLIENTES->NUMERO := cNumero
CLIENTES->COMPLE := cComple
CLIENTES->BAIRRO := cBairro
CLIENTES->CIDADE := cCidade
CLIENTES->ESTADO := cEstado
CLIENTES->LIMITE := nLimite
CLIENTES->DTCAD := dDtCad
CLIENTES->STATUS := cStatus
CLIENTES->OBS := cObs
CLIENTES->( DbUnlock() )
CLIENTES->( DbCommit() )
MsgInfo( "Cliente gravado com sucesso!", "Sucesso" )
oDlg:End( IDOK )
RETURN .T.
// ----------------------------------------------------------------------------
// EXCLUSAO DE CLIENTE
// ----------------------------------------------------------------------------
STATIC FUNCTION ExcluirCliente( oBrw )
IF RecCount() == 0
RETURN NIL
ENDIF
IF MsgYesNo( "Deseja realmente excluir o cliente:" + CRLF + CRLF + ;
AllTrim( CLIENTES->CODIGO ) + " - " + AllTrim( CLIENTES->NOME ) + "?", ;
"Confirmação de Exclusão" )
CLIENTES->( RLock() )
CLIENTES->( DbDelete() )
CLIENTES->( DbUnlock() )
CLIENTES->( DbCommit() )
CLIENTES->( DbSkip() )
IF CLIENTES->( Eof() )
CLIENTES->( DbGoBottom() )
ENDIF
oBrw:Refresh()
MsgInfo( "Cliente excluÃdo com sucesso!", "Informação" )
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------
// INTEGRACAO WHATSAPP WEB
// ----------------------------------------------------------------------------
FUNCTION AbrirWhatsApp( cFone )
LOCAL cLimpo := LimparNumero( cFone )
LOCAL cUrl
IF Empty( cLimpo )
MsgAlert( "Nenhum número de WhatsApp informado para este cliente!", "Atenção" )
RETURN NIL
ENDIF
IF Left( cLimpo, 2 ) != "55" .AND. Len( cLimpo ) <= 11
cLimpo := "55" + cLimpo
ENDIF
cUrl := "https://wa.me/" + cLimpo
ShellExecute( 0, "open", cUrl, 0, 0, 1 )
RETURN NIL
// ----------------------------------------------------------------------------
// INTEGRACAO GOOGLE MAPS
// ----------------------------------------------------------------------------
FUNCTION AbrirMapa( cEnd, cNum, cCid, cUf )
LOCAL cBusca := AllTrim( cEnd ) + ", " + AllTrim( cNum ) + ", " + AllTrim( cCid ) + " - " + AllTrim( cUf )
LOCAL cUrl
IF Empty( AllTrim( cEnd ) )
MsgAlert( "Endereço não cadastrado para este cliente!", "Atenção" )
RETURN NIL
ENDIF
cUrl := "https://www.google.com/maps/search/?api=1&query=" + StrTran( cBusca, " ", "+" )
ShellExecute( 0, "open", cUrl, 0, 0, 1 )
RETURN NIL
// ----------------------------------------------------------------------------
// CONSULTA VIACEP (WEBSERVICE)
// ----------------------------------------------------------------------------
FUNCTION BuscarViaCEP( cCep, cEndereco, cBairro, cCidade, cEstado, oDlg )
LOCAL oHttp, cUrl, cCleanCep, hJson, nDecoded, lOk := .F.
cCleanCep := LimparNumero( cCep )
IF Len( cCleanCep ) != 8
MsgAlert( "Informe um CEP válido com 8 dÃgitos!", "ViaCEP" )
RETURN NIL
ENDIF
cUrl := "https://viacep.com.br/ws/" + cCleanCep + "/json/"
TRY
oHttp := CreateObject( "MSXML2.XMLHTTP" )
CATCH
TRY
oHttp := CreateObject( "Microsoft.XMLHTTP" )
CATCH
oHttp := NIL
END
END
IF oHttp == NIL
MsgStop( "Não foi possÃvel instanciar o componente HTTP!", "Erro" )
RETURN NIL
ENDIF
TRY
oHttp:Open( "GET", cUrl, .F. )
oHttp:Send()
IF oHttp:Status == 200
nDecoded := hb_jsonDecode( oHttp:ResponseText, @hJson )
IF nDecoded > 0 .AND. HB_ISHASH( hJson )
IF HB_HHasKey( hJson, "erro" )
MsgAlert( "CEP não localizado no banco de dados dos Correios!", "ViaCEP" )
ELSE
cEndereco := PadR( hb_UTF8ToStr( hJson["logradouro"] ), 50 )
cBairro := PadR( hb_UTF8ToStr( hJson["bairro"] ), 35 )
cCidade := PadR( hb_UTF8ToStr( hJson["localidade"] ), 35 )
cEstado := PadR( hb_UTF8ToStr( hJson["uf"] ), 2 )
oDlg:Update()
lOk := .T.
MsgInfo( "Endereço localizado com sucesso!", "ViaCEP" )
ENDIF
ELSE
MsgStop( "Resposta inválida do serviço ViaCEP!", "Erro" )
ENDIF
ELSE
MsgStop( "Falha na comunicação com ViaCEP: " + Str( oHttp:Status ), "Erro" )
ENDIF
CATCH
MsgStop( "Erro ao conectar com a API ViaCEP.", "Erro" )
END
RETURN lOk
// ----------------------------------------------------------------------------
// CONSULTA RECEITA WS (CNPJ)
// ----------------------------------------------------------------------------
FUNCTION BuscarReceitaWS( cDoc, cNome, cFantasia, cEndereco, cNumero, cComple, cBairro, cCidade, cEstado, cCep, cFone, oDlg )
LOCAL oHttp, cUrl, cCleanCnpj, hJson, nDecoded, lOk := .F.
cCleanCnpj := LimparNumero( cDoc )
IF Len( cCleanCnpj ) != 14
MsgAlert( "Informe um CNPJ válido com 14 dÃgitos!", "ReceitaWS" )
RETURN NIL
ENDIF
cUrl := "https://www.receitaws.com.br/v1/cnpj/" + cCleanCnpj
TRY
oHttp := CreateObject( "MSXML2.XMLHTTP" )
CATCH
TRY
oHttp := CreateObject( "Microsoft.XMLHTTP" )
CATCH
oHttp := NIL
END
END
IF oHttp == NIL
MsgStop( "Não foi possÃvel instanciar o componente HTTP!", "Erro" )
RETURN NIL
ENDIF
TRY
oHttp:Open( "GET", cUrl, .F. )
oHttp:Send()
IF oHttp:Status == 200
nDecoded := hb_jsonDecode( oHttp:ResponseText, @hJson )
IF nDecoded > 0 .AND. HB_ISHASH( hJson )
IF HB_HHasKey( hJson, "status" ) .AND. hJson["status"] == "ERROR"
MsgAlert( "CNPJ não encontrado ou com erro: " + hJson["message"], "ReceitaWS" )
ELSE
cNome := PadR( hb_UTF8ToStr( hJson["nome"] ), 50 )
cFantasia := PadR( hb_UTF8ToStr( hJson["fantasia"] ), 40 )
cEndereco := PadR( hb_UTF8ToStr( hJson["logradouro"] ), 50 )
cNumero := PadR( hb_UTF8ToStr( hJson["numero"] ), 10 )
cComple := PadR( hb_UTF8ToStr( hJson["complemento"] ), 30 )
cBairro := PadR( hb_UTF8ToStr( hJson["bairro"] ), 35 )
cCidade := PadR( hb_UTF8ToStr( hJson["municipio"] ), 35 )
cEstado := PadR( hb_UTF8ToStr( hJson["uf"] ), 2 )
cCep := PadR( LimparNumero( hJson["cep"] ), 10 )
cFone := PadR( hb_UTF8ToStr( hJson["telefone"] ), 20 )
oDlg:Update()
lOk := .T.
MsgInfo( "Dados da empresa importados da Receita Federal com sucesso!", "ReceitaWS" )
ENDIF
ELSE
MsgStop( "Resposta inválida da Receita Federal!", "Erro" )
ENDIF
ELSE
MsgStop( "Falha na comunicação com ReceitaWS: " + Str( oHttp:Status ), "Erro" )
ENDIF
CATCH
MsgStop( "Erro ao conectar com a API ReceitaWS.", "Erro" )
END
RETURN lOk
// ----------------------------------------------------------------------------
// VALIDADOR OFICIAL DE CPF (MODULO 11)
// ----------------------------------------------------------------------------
FUNCTION ValidarCPF( cCpf )
LOCAL nSoma1 := 0, nSoma2 := 0, nDig1, nDig2, i
cCpf := LimparNumero( cCpf )
IF Len( cCpf ) != 11 .OR. cCpf == Replicate( SubStr( cCpf, 1, 1 ), 11 )
RETURN .F.
ENDIF
FOR i := 1 TO 9
nSoma1 += Val( SubStr( cCpf, i, 1 ) ) * ( 11 - i )
NEXT
nDig1 := ( nSoma1 * 10 ) % 11
IF nDig1 == 10 .OR. nDig1 == 11
nDig1 := 0
ENDIF
IF nDig1 != Val( SubStr( cCpf, 10, 1 ) )
RETURN .F.
ENDIF
FOR i := 1 TO 10
nSoma2 += Val( SubStr( cCpf, i, 1 ) ) * ( 12 - i )
NEXT
nDig2 := ( nSoma2 * 10 ) % 11
IF nDig2 == 10 .OR. nDig2 == 11
nDig2 := 0
ENDIF
IF nDig2 != Val( SubStr( cCpf, 11, 1 ) )
RETURN .F.
ENDIF
RETURN .T.
// ----------------------------------------------------------------------------
// VALIDADOR OFICIAL DE CNPJ (MODULO 11)
// ----------------------------------------------------------------------------
FUNCTION ValidarCNPJ( cCnpj )
LOCAL aPesos1 := { 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2 }
LOCAL aPesos2 := { 6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2 }
LOCAL nSoma1 := 0, nSoma2 := 0, nResto1, nResto2, nDig1, nDig2, i
cCnpj := LimparNumero( cCnpj )
IF Len( cCnpj ) != 14 .OR. cCnpj == Replicate( SubStr( cCnpj, 1, 1 ), 14 )
RETURN .F.
ENDIF
FOR i := 1 TO 12
nSoma1 += Val( SubStr( cCnpj, i, 1 ) ) * aPesos1[i]
NEXT
nResto1 := nSoma1 % 11
nDig1 := If( nResto1 < 2, 0, 11 - nResto1 )
IF nDig1 != Val( SubStr( cCnpj, 13, 1 ) )
RETURN .F.
ENDIF
FOR i := 1 TO 13
nSoma2 += Val( SubStr( cCnpj, i, 1 ) ) * aPesos2[i]
NEXT
nResto2 := nSoma2 % 11
nDig2 := If( nResto2 < 2, 0, 11 - nResto2 )
IF nDig2 != Val( SubStr( cCnpj, 14, 1 ) )
RETURN .F.
ENDIF
RETURN .T.
// ----------------------------------------------------------------------------
// AUXILIARES: CODIGO, TOTALIZADORES E LIMPEZA
// ----------------------------------------------------------------------------
STATIC FUNCTION ProximoCodigo()
LOCAL nMax := 0, nRec := CLIENTES->( RecNo() )
CLIENTES->( DbGoTop() )
WHILE !CLIENTES->( Eof() )
nMax := Max( nMax, Val( CLIENTES->CODIGO ) )
CLIENTES->( DbSkip() )
ENDDO
CLIENTES->( DbGoto( nRec ) )
RETURN StrZero( nMax + 1, 6 )
STATIC FUNCTION TotalLimite()
LOCAL nTot := 0, nRec := CLIENTES->( RecNo() )
CLIENTES->( DbGoTop() )
WHILE !CLIENTES->( Eof() )
nTot += CLIENTES->LIMITE
CLIENTES->( DbSkip() )
ENDDO
CLIENTES->( DbGoto( nRec ) )
RETURN nTot
STATIC FUNCTION LimparNumero( cStr )
LOCAL cRet := "", i, ch
cStr := AllTrim( cStr )
FOR i := 1 TO Len( cStr )
ch := SubStr( cStr, i, 1 )
IF ch >= "0" .AND. ch <= "9"
cRet += ch
ENDIF
NEXT
RETURN cRet
// ----------------------------------------------------------------------------
// CRIACAO E INICIALIZACAO DA BASE DE DADOS (DBF / CDX)
// ----------------------------------------------------------------------------
STATIC FUNCTION InitDatabase()
LOCAL aCampos := {}
IF !File( "CADCLIE.DBF" )
aAdd( aCampos, { "CODIGO", "C", 6, 0 } )
aAdd( aCampos, { "TIPO", "C", 2, 0 } )
aAdd( aCampos, { "NOME", "C", 50, 0 } )
aAdd( aCampos, { "FANTASIA", "C", 40, 0 } )
aAdd( aCampos, { "DOC", "C", 18, 0 } )
aAdd( aCampos, { "RG_IE", "C", 20, 0 } )
aAdd( aCampos, { "FONE", "C", 20, 0 } )
aAdd( aCampos, { "CELULAR", "C", 20, 0 } )
aAdd( aCampos, { "EMAIL", "C", 60, 0 } )
aAdd( aCampos, { "CEP", "C", 10, 0 } )
aAdd( aCampos, { "ENDERECO", "C", 50, 0 } )
aAdd( aCampos, { "NUMERO", "C", 10, 0 } )
aAdd( aCampos, { "COMPLE", "C", 30, 0 } )
aAdd( aCampos, { "BAIRRO", "C", 35, 0 } )
aAdd( aCampos, { "CIDADE", "C", 35, 0 } )
aAdd( aCampos, { "ESTADO", "C", 2, 0 } )
aAdd( aCampos, { "LIMITE", "N", 12, 2 } )
aAdd( aCampos, { "DTCAD", "D", 8, 0 } )
aAdd( aCampos, { "STATUS", "C", 1, 0 } )
aAdd( aCampos, { "OBS", "M", 10, 0 } )
DbCreate( "CADCLIE.DBF", aCampos, "DBFCDX" )
USE CADCLIE EXCLUSIVE NEW VIA "DBFCDX"
INDEX ON FIELD->CODIGO TAG CODIGO TO CADCLIE
INDEX ON FIELD->NOME TAG NOME TO CADCLIE
INDEX ON FIELD->DOC TAG DOC TO CADCLIE
// Populando com Registros Iniciais de Exemplo
DbAppend()
CADCLIE->CODIGO := "000001"
CADCLIE->TIPO := "PJ"
CADCLIE->NOME := "TECH SOLUTIONS BRASIL LTDA"
CADCLIE->FANTASIA := "TECH BRASIL"
CADCLIE->DOC := "12.345.678/0001-90"
CADCLIE->RG_IE := "112.334.556.778"
CADCLIE->FONE := "(11) 3322-1100"
CADCLIE->CELULAR := "(11) 98765-4321"
CADCLIE->EMAIL := "contato@techbrasil.com.br"
CADCLIE->CEP := "01310-100"
CADCLIE->ENDERECO := "AVENIDA PAULISTA"
CADCLIE->NUMERO := "1000"
CADCLIE->COMPLE := "CONJ 1401"
CADCLIE->BAIRRO := "BELA VISTA"
CADCLIE->CIDADE := "SAO PAULO"
CADCLIE->ESTADO := "SP"
CADCLIE->LIMITE := 25000.00
CADCLIE->DTCAD := Date() - 120
CADCLIE->STATUS := "A"
CADCLIE->OBS := "Cliente corporativo VIP com faturamento quinzenal."
DbAppend()
CADCLIE->CODIGO := "000002"
CADCLIE->TIPO := "PF"
CADCLIE->NOME := "MARIA APARECIDA DA SILVA"
CADCLIE->FANTASIA := "MARIA SILVA"
CADCLIE->DOC := "123.456.789-00"
CADCLIE->RG_IE := "22.333.444-5"
CADCLIE->FONE := "(21) 2233-4455"
CADCLIE->CELULAR := "(21) 99887-6655"
CADCLIE->EMAIL := "maria.silva@email.com"
CADCLIE->CEP := "22041-010"
CADCLIE->ENDERECO := "AVENIDA COPACABANA"
CADCLIE->NUMERO := "500"
CADCLIE->COMPLE := "APTO 802"
CADCLIE->BAIRRO := "COPACABANA"
CADCLIE->CIDADE := "RIO DE JANEIRO"
CADCLIE->ESTADO := "RJ"
CADCLIE->LIMITE := 5000.00
CADCLIE->DTCAD := Date() - 60
CADCLIE->STATUS := "A"
CADCLIE->OBS := "Cliente preferencial, prefere contato por WhatsApp."
DbAppend()
CADCLIE->CODIGO := "000003"
CADCLIE->TIPO := "PJ"
CADCLIE->NOME := "DISTRIBUIDORA DE ALIMENTOS CENTRAL"
CADCLIE->FANTASIA := "CENTRAL FOODS"
CADCLIE->DOC := "98.765.432/0001-11"
CADCLIE->RG_IE := "ISENTO"
CADCLIE->FONE := "(31) 3456-7890"
CADCLIE->CELULAR := "(31) 98877-1122"
CADCLIE->EMAIL := "compras@centralfoods.com.br"
CADCLIE->CEP := "30130-000"
CADCLIE->ENDERECO := "AVENIDA AFONSO PENA"
CADCLIE->NUMERO := "1500"
CADCLIE->COMPLE := "GALPAO B"
CADCLIE->BAIRRO := "CENTRO"
CADCLIE->CIDADE := "BELO HORIZONTE"
CADCLIE->ESTADO := "MG"
CADCLIE->LIMITE := 45000.00
CADCLIE->DTCAD := Date() - 300
CADCLIE->STATUS := "B"
CADCLIE->OBS := "Bloqueado temporariamente por pendência financeira."
DbAppend()
CADCLIE->CODIGO := "000004"
CADCLIE->TIPO := "PF"
CADCLIE->NOME := "ROBERTO CARLOS DOS SANTOS"
CADCLIE->FANTASIA := "ROBERTO SANTOS"
CADCLIE->DOC := "987.654.321-99"
CADCLIE->RG_IE := "33.444.555-6"
CADCLIE->FONE := "(41) 3211-0099"
CADCLIE->CELULAR := "(41) 99112-3344"
CADCLIE->EMAIL := "roberto.santos@gmail.com"
CADCLIE->CEP := "80020-010"
CADCLIE->ENDERECO := "RUA XV DE NOVEMBRO"
CADCLIE->NUMERO := "350"
CADCLIE->COMPLE := "SALA 42"
CADCLIE->BAIRRO := "CENTRO"
CADCLIE->CIDADE := "CURITIBA"
CADCLIE->ESTADO := "PR"
CADCLIE->LIMITE := 8000.00
CADCLIE->DTCAD := Date() - 15
CADCLIE->STATUS := "A"
CADCLIE->OBS := "Cadastro recente. Entregas em horário comercial."
USE
ENDIF
USE CADCLIE SHARED NEW ALIAS CLIENTES VIA "DBFCDX"
IF !File( "CADCLIE.CDX" )
INDEX ON FIELD->CODIGO TAG CODIGO TO CADCLIE
INDEX ON FIELD->NOME TAG NOME TO CADCLIE
INDEX ON FIELD->DOC TAG DOC TO CADCLIE
ENDIF
SET ORDER TO TAG CODIGO
DbGoTop()
RETURN .T.Gracias, tks.
Regards, saludos.
Estimado João
Para cambiar el idioma Pulsar: Ctrl-Shift-P Escribir: Configure Display Language Elegir el idioma desado
Para los caracteres especiales -Dar click en: UTF-8 en la barra inferior Click en: Volver a abrir en Encoding Elegir: Windows 1252
Cerrar Antigravity y volver a abrir
Saludos,
Adhemar Cuéllar
Probé el DEEPSEEK chino y me pareció mucho más interesante que el ANTIGRAVITY; es totalmente intuitivo y fácil de entender. No tuve que configurar NADA.
Cadastro de Espécies/Raças PARA PETSHOP em FIVEWIN e .DBF
Aqui está um sistema completo de Cadastro de Espécies/Raças PARA PETSHOP usando FiveWin e .DBF, com relacionamento entre as tabelas.
?? Estrutura dos Arquivos DBF
1. ESPECIE.DBF
xbase
// Tabela de Espécies
CREATE TABLE Especie ( ;
ID N( 6, 0 ), ; // Código único da espécie
DESCRICAO C( 30 ), ; // Ex: Cachorro, Gato, Pássaro
OBSERVACAO C( 50 ), ; // Observações adicionais
ATIVO L // .T. = Ativo, .F. = Inativo
)
2. RACA.DBF
xbase
// Tabela de Raças (relacionada com Espécie)
CREATE TABLE Raca ( ;
ID N( 6, 0 ), ; // Código único da raça
ID_ESPECIE N( 6, 0 ), ; // Chave estrangeira para ESPECIE.DBF
DESCRICAO C( 40 ), ; // Ex: Poodle, Siamês, Calopsita
PORTE C( 10 ), ; // Pequeno, Médio, Grande (para cães)
PELO C( 15 ), ; // Curto, Médio, Longo, Sem pelo
OBSERVACAO C( 50 ), ; // Observações
ATIVO L // .T. = Ativo, .F. = Inativo
)
??? Código Fonte Completo
?? CADESPECIE.PRG ( Cadastro de Espécies )
xbase
#include "FiveWin.ch"
#include "DbStruct.ch"
//----------------------------------------------------------------------------//
// Função principal - Cadastro de Espécies
//----------------------------------------------------------------------------//
FUNCTION CadEspecie()
LOCAL oDlg, oBrw
LOCAL lIncluindo := .F. , lEditando := .F.
// Abrir arquivo
IF !File( "ESPECIE.DBF" )
CriarEstruturaEspecie()
ENDIF
USE Especie shared NEW
IF !used()
MsgStop( "Erro ao abrir ESPECIE.DBF" )
RETURN nil
ENDIF
SET ORDER TO 1 // Índice por ID
dbGoTop()
// Diálogo principal
DEFINE DIALOG oDlg TITLE "Cadastro de Espécies" ;
FROM 10, 10 TO 400, 600 PIXEL
// Campos
@ 050, 20 SAY "Código:" SIZE 60, 20 PIXEL OF oDlg
@ 050, 90 GET oGetID VAR Especie->ID PICTURE "999999" ;
SIZE 100, 24 PIXEL OF oDlg UPDATE
@ 090, 20 SAY "Descrição:" SIZE 60, 20 PIXEL OF oDlg
@ 090, 90 GET oGetDesc VAR Especie->DESCRICAO ;
SIZE 300, 24 PIXEL OF oDlg UPDATE
@ 130, 20 SAY "Observação:" SIZE 60, 20 PIXEL OF oDlg
@ 130, 90 GET oGetObs VAR Especie->OBSERVACAO ;
SIZE 300, 24 PIXEL OF oDlg UPDATE
@ 170, 20 SAY "Ativo:" SIZE 60, 20 PIXEL OF oDlg
@ 170, 90 CHECKBOX oChkAtivo VAR Especie->ATIVO ;
PROMPT "Sim" SIZE 80, 24 PIXEL OF oDlg UPDATE
// Botões de navegação
@ 220, 20 BTNBTN oBtnPrimeiro PROMPT "|<" ACTION ( dbGoTop(), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 220, 65 BTNBTN oBtnAnterior PROMPT "<" ACTION ( dbSkip( - 1 ), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 220, 110 BTNBTN oBtnProximo PROMPT ">" ACTION ( dbSkip( 1 ), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 220, 155 BTNBTN oBtnUltimo PROMPT ">|" ACTION ( dbGoBottom(), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
// Botões de ação
@ 280, 20 BTNBTN oBtnIncluir PROMPT "Incluir" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( IncluirEspecie( oDlg, @lIncluindo, @lEditando ) )
@ 280, 110 BTNBTN oBtnAlterar PROMPT "Alterar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( AlterarEspecie( oDlg, @lIncluindo, @lEditando ) )
@ 280, 200 BTNBTN oBtnExcluir PROMPT "Excluir" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( ExcluirEspecie( oDlg ) )
@ 280, 290 BTNBTN oBtnSalvar PROMPT "Salvar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( SalvarEspecie( oDlg, @lIncluindo, @lEditando ) )
@ 280, 380 BTNBTN oBtnCancelar PROMPT "Cancelar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( CancelarEspecie( oDlg, @lIncluindo, @lEditando ) )
@ 280, 470 BTNBTN oBtnSair PROMPT "Sair" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( oDlg:End() )
// Atualiza estado dos botões
AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
ACTIVATE DIALOG oDlg CENTERED
USE
RETURN nil
//----------------------------------------------------------------------------//
// Cria estrutura ESPECIE.DBF
//----------------------------------------------------------------------------//
STATIC FUNCTION CriarEstruturaEspecie()
LOCAL aStruct := { ;
{ "ID", "N", 6, 0 }, ;
{ "DESCRICAO", "C", 30, 0 }, ;
{ "OBSERVACAO", "C", 50, 0 }, ;
{ "ATIVO", "L", 1, 0 } ;
}
dbCreate( "ESPECIE.DBF", aStruct, "DBFCDX" )
// Cria índice
USE Especie
INDEX ON ID TAG ID
INDEX ON DESCRICAO TAG DESCRICAO
CLOSE
RETURN nil
//----------------------------------------------------------------------------//
// Incluir Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION IncluirEspecie( oDlg, lIncluindo, lEditando )
IF lIncluindo .OR. lEditando
MsgStop( "Finalize a operação atual primeiro!" )
RETURN nil
ENDIF
lIncluindo := .T.
dbAppend()
Especie->ID := NextIDEspecie()
Especie->ATIVO := .T.
oDlg:Update()
AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Alterar Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION AlterarEspecie( oDlg, lIncluindo, lEditando )
IF lIncluindo .OR. lEditando
MsgStop( "Finalize a operação atual primeiro!" )
RETURN nil
ENDIF
IF eof()
MsgStop( "Não há registro para alterar!" )
RETURN nil
ENDIF
lEditando := .T.
AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Excluir Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION ExcluirEspecie( oDlg )
LOCAL nResposta
IF eof()
MsgStop( "Não há registro para excluir!" )
RETURN nil
ENDIF
// Verifica se existem raças vinculadas
IF ExisteRacaVinculada( Especie->ID )
MsgStop( "Não é possível excluir esta espécie pois existem raças vinculadas!" )
RETURN nil
ENDIF
nResposta := MsgYesNo( "Deseja excluir a espécie: " + AllTrim( Especie->DESCRICAO ) + "?", "Confirmar Exclusão" )
IF nResposta == .T.
// Exclusão lógica
Especie->ATIVO := .F.
oDlg:Update()
MsgInfo( "Espécie marcada como inativa!" )
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
// Salvar Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION SalvarEspecie( oDlg, lIncluindo, lEditando )
LOCAL cDesc := AllTrim( Especie->DESCRICAO )
IF Empty( cDesc )
MsgStop( "A descrição é obrigatória!" )
RETURN nil
ENDIF
IF lIncluindo .OR. lEditando
dbCommit()
lIncluindo := .F.
lEditando := .F.
MsgInfo( "Registro salvo com sucesso!" )
oDlg:Update()
AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
ELSE
MsgStop( "Nenhuma operação em andamento!" )
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
// Cancelar Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION CancelarEspecie( oDlg, lIncluindo, lEditando )
IF lIncluindo
dbRecall()
dbGoTop()
lIncluindo := .F.
MsgInfo( "Inclusão cancelada!" )
ENDIF
IF lEditando
dbGoBottom()
dbSkip( 0 )
lEditando := .F.
MsgInfo( "Alteração cancelada!" )
ENDIF
oDlg:Update()
AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Atualiza botões - Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION AtualizaBotoesEspecie( oDlg, lIncluindo, lEditando )
LOCAL lHabilitado := !( lIncluindo .OR. lEditando )
LOCAL i
FOR i := 1 TO len( oDlg:aControls )
IF i <= 8 // Botões de navegação e ação (até Excluir)
oDlg:aControls[i]:Enable( lHabilitado )
ELSEIF i == 9 // Salvar
oDlg:aControls[i]:Enable( lIncluindo .OR. lEditando )
ELSEIF i == 10 // Cancelar
oDlg:aControls[i]:Enable( lIncluindo .OR. lEditando )
ELSEIF i == 11 // Sair
oDlg:aControls[i]:Enable( .T. )
ENDIF
NEXT
RETURN nil
//----------------------------------------------------------------------------//
// Próximo ID - Espécie
//----------------------------------------------------------------------------//
STATIC FUNCTION NextIDEspecie()
LOCAL nMax := 0
LOCAL nRecno := recno()
dbGoTop()
DO WHILE !eof()
IF Especie->ID > nMax
nMax := Especie->ID
ENDIF
dbSkip( 1 )
ENDDO
dbGoTo( nRecno )
RETURN nMax + 1
//----------------------------------------------------------------------------//
// Verifica se existem raças vinculadas
//----------------------------------------------------------------------------//
STATIC FUNCTION ExisteRacaVinculada( nIDEspecie )
LOCAL lExiste := .F.
// Abre arquivo de raças
IF !File( "RACA.DBF" )
RETURN .F.
ENDIF
USE Raca shared NEW
IF used()
SET ORDER TO 2 // Índice por ID_ESPECIE
SEEK nIDEspecie
IF found()
lExiste := .T.
ENDIF
USE
ENDIF
RETURN lExiste
//----------------------------------------------------------------------------//
?? CADRACA.PRG ( Cadastro de Raças )
xbase
#include "FiveWin.ch"
#include "DbStruct.ch"
//----------------------------------------------------------------------------//
// Função principal - Cadastro de Raças
//----------------------------------------------------------------------------//
FUNCTION CadRaca()
LOCAL oDlg, oDlgEspecie
LOCAL lIncluindo := .F. , lEditando := .F.
LOCAL aEspecies := {}
// Abrir arquivos
IF !File( "RACA.DBF" )
CriarEstruturaRaca()
ENDIF
USE Raca shared NEW
IF !used()
MsgStop( "Erro ao abrir RACA.DBF" )
RETURN nil
ENDIF
// Abrir espécies para combo
IF File( "ESPECIE.DBF" )
USE Especie shared NEW
IF used()
SET ORDER TO 2 // Por descrição
dbGoTop()
DO WHILE !eof()
IF Especie->ATIVO
aAdd( aEspecies, { Especie->ID, AllTrim( Especie->DESCRICAO ) } )
ENDIF
dbSkip( 1 )
ENDDO
USE
ENDIF
ENDIF
SET ORDER TO 1 // Índice por ID
dbGoTop()
// Diálogo principal
DEFINE DIALOG oDlg TITLE "Cadastro de Raças" ;
FROM 10, 10 TO 500, 700 PIXEL
// Campos
@ 050, 20 SAY "Código:" SIZE 60, 20 PIXEL OF oDlg
@ 050, 90 GET oGetID VAR Raca->ID PICTURE "999999" ;
SIZE 100, 24 PIXEL OF oDlg UPDATE
@ 090, 20 SAY "Espécie:" SIZE 60, 20 PIXEL OF oDlg
@ 090, 90 COMBOBOX oCbxEspecie VAR Raca->ID_ESPECIE ;
ITEMS aEspecies ;
SIZE 200, 100 PIXEL OF oDlg UPDATE
@ 130, 20 SAY "Descrição:" SIZE 60, 20 PIXEL OF oDlg
@ 130, 90 GET oGetDesc VAR Raca->DESCRICAO ;
SIZE 300, 24 PIXEL OF oDlg UPDATE
@ 170, 20 SAY "Porte:" SIZE 60, 20 PIXEL OF oDlg
@ 170, 90 COMBOBOX oCbxPorte VAR Raca->PORTE ;
ITEMS { "Pequeno", "Médio", "Grande" } ;
SIZE 150, 80 PIXEL OF oDlg UPDATE
@ 210, 20 SAY "Tipo de Pelo:" SIZE 80, 20 PIXEL OF oDlg
@ 210, 90 COMBOBOX oCbxPelo VAR Raca->PELO ;
ITEMS { "Curto", "Médio", "Longo", "Sem pelo" } ;
SIZE 150, 80 PIXEL OF oDlg UPDATE
@ 250, 20 SAY "Observação:" SIZE 60, 20 PIXEL OF oDlg
@ 250, 90 GET oGetObs VAR Raca->OBSERVACAO ;
SIZE 300, 24 PIXEL OF oDlg UPDATE
@ 290, 20 SAY "Ativo:" SIZE 60, 20 PIXEL OF oDlg
@ 290, 90 CHECKBOX oChkAtivo VAR Raca->ATIVO ;
PROMPT "Sim" SIZE 80, 24 PIXEL OF oDlg UPDATE
// Botões de navegação
@ 340, 20 BTNBTN oBtnPrimeiro PROMPT "|<" ACTION ( dbGoTop(), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 340, 65 BTNBTN oBtnAnterior PROMPT "<" ACTION ( dbSkip( - 1 ), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 340, 110 BTNBTN oBtnProximo PROMPT ">" ACTION ( dbSkip( 1 ), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
@ 340, 155 BTNBTN oBtnUltimo PROMPT ">|" ACTION ( dbGoBottom(), oDlg:Update() ) SIZE 40, 30 PIXEL OF oDlg
// Botões de ação
@ 400, 20 BTNBTN oBtnIncluir PROMPT "Incluir" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( IncluirRaca( oDlg, @lIncluindo, @lEditando ) )
@ 400, 110 BTNBTN oBtnAlterar PROMPT "Alterar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( AlterarRaca( oDlg, @lIncluindo, @lEditando ) )
@ 400, 200 BTNBTN oBtnExcluir PROMPT "Excluir" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( ExcluirRaca( oDlg ) )
@ 400, 290 BTNBTN oBtnSalvar PROMPT "Salvar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( SalvarRaca( oDlg, @lIncluindo, @lEditando ) )
@ 400, 380 BTNBTN oBtnCancelar PROMPT "Cancelar" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( CancelarRaca( oDlg, @lIncluindo, @lEditando ) )
@ 400, 470 BTNBTN oBtnSair PROMPT "Sair" SIZE 80, 35 PIXEL OF oDlg ;
ACTION ( oDlg:End() )
// Atualiza estado dos botões
AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
ACTIVATE DIALOG oDlg CENTERED
USE
RETURN nil
//----------------------------------------------------------------------------//
// Cria estrutura RACA.DBF
//----------------------------------------------------------------------------//
STATIC FUNCTION CriarEstruturaRaca()
LOCAL aStruct := { ;
{ "ID", "N", 6, 0 }, ;
{ "ID_ESPECIE", "N", 6, 0 }, ;
{ "DESCRICAO", "C", 40, 0 }, ;
{ "PORTE", "C", 10, 0 }, ;
{ "PELO", "C", 15, 0 }, ;
{ "OBSERVACAO", "C", 50, 0 }, ;
{ "ATIVO", "L", 1, 0 } ;
}
dbCreate( "RACA.DBF", aStruct, "DBFCDX" )
// Cria índices
USE Raca
INDEX ON ID TAG ID
INDEX ON ID_ESPECIE TAG ID_ESPECIE
INDEX ON DESCRICAO TAG DESCRICAO
CLOSE
RETURN nil
//----------------------------------------------------------------------------//
// Incluir Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION IncluirRaca( oDlg, lIncluindo, lEditando )
IF lIncluindo .OR. lEditando
MsgStop( "Finalize a operação atual primeiro!" )
RETURN nil
ENDIF
lIncluindo := .T.
dbAppend()
Raca->ID := NextIDRaca()
Raca->ATIVO := .T.
oDlg:Update()
AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Alterar Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION AlterarRaca( oDlg, lIncluindo, lEditando )
IF lIncluindo .OR. lEditando
MsgStop( "Finalize a operação atual primeiro!" )
RETURN nil
ENDIF
IF eof()
MsgStop( "Não há registro para alterar!" )
RETURN nil
ENDIF
lEditando := .T.
AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Excluir Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION ExcluirRaca( oDlg )
LOCAL nResposta
IF eof()
MsgStop( "Não há registro para excluir!" )
RETURN nil
ENDIF
// Verifica se existem animais vinculados (se tiver tabela de animais)
IF ExisteAnimalVinculado( Raca->ID )
MsgStop( "Não é possível excluir esta raça pois existem animais vinculados!" )
RETURN nil
ENDIF
nResposta := MsgYesNo( "Deseja excluir a raça: " + AllTrim( Raca->DESCRICAO ) + "?", "Confirmar Exclusão" )
IF nResposta == .T.
Raca->ATIVO := .F.
oDlg:Update()
MsgInfo( "Raça marcada como inativa!" )
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
// Salvar Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION SalvarRaca( oDlg, lIncluindo, lEditando )
LOCAL cDesc := AllTrim( Raca->DESCRICAO )
IF Empty( cDesc )
MsgStop( "A descrição é obrigatória!" )
RETURN nil
ENDIF
IF Raca->ID_ESPECIE == 0
MsgStop( "Selecione uma espécie!" )
RETURN nil
ENDIF
IF lIncluindo .OR. lEditando
dbCommit()
lIncluindo := .F.
lEditando := .F.
MsgInfo( "Registro salvo com sucesso!" )
oDlg:Update()
AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
ELSE
MsgStop( "Nenhuma operação em andamento!" )
ENDIF
RETURN nil
//----------------------------------------------------------------------------//
// Cancelar Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION CancelarRaca( oDlg, lIncluindo, lEditando )
IF lIncluindo
dbRecall()
dbGoTop()
lIncluindo := .F.
MsgInfo( "Inclusão cancelada!" )
ENDIF
IF lEditando
dbGoBottom()
dbSkip( 0 )
lEditando := .F.
MsgInfo( "Alteração cancelada!" )
ENDIF
oDlg:Update()
AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
RETURN nil
//----------------------------------------------------------------------------//
// Atualiza botões - Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION AtualizaBotoesRaca( oDlg, lIncluindo, lEditando )
LOCAL lHabilitado := !( lIncluindo .OR. lEditando )
LOCAL i
FOR i := 1 TO len( oDlg:aControls )
IF i <= 8 // Botões de navegação e ação (até Excluir)
oDlg:aControls[i]:Enable( lHabilitado )
ELSEIF i == 9 // Salvar
oDlg:aControls[i]:Enable( lIncluindo .OR. lEditando )
ELSEIF i == 10 // Cancelar
oDlg:aControls[i]:Enable( lIncluindo .OR. lEditando )
ELSEIF i == 11 // Sair
oDlg:aControls[i]:Enable( .T. )
ENDIF
NEXT
RETURN nil
//----------------------------------------------------------------------------//
// Próximo ID - Raça
//----------------------------------------------------------------------------//
STATIC FUNCTION NextIDRaca()
LOCAL nMax := 0
LOCAL nRecno := recno()
dbGoTop()
DO WHILE !eof()
IF Raca->ID > nMax
nMax := Raca->ID
ENDIF
dbSkip( 1 )
ENDDO
dbGoTo( nRecno )
RETURN nMax + 1
//----------------------------------------------------------------------------//
// Verifica se existem animais vinculados (função exemplo)
//----------------------------------------------------------------------------//
STATIC FUNCTION ExisteAnimalVinculado( nIDRaca )
LOCAL lExiste := .F.
// Se tiver uma tabela ANIMAL.DBF, verifica aqui
// if File("ANIMAL.DBF")
// use Animal shared new
// if used()
// set order to 3 // Índice por ID_RACA
// seek nIDRaca
// if found()
// lExiste := .T.
// endif
// use
// endif
// endif
RETURN lExiste
//----------------------------------------------------------------------------//
??? Programa Principal ( MENU.PRG )
xbase
#include "FiveWin.ch"
//----------------------------------------------------------------------------//
FUNCTION Main()
LOCAL oWnd
DEFINE WINDOW oWnd TITLE "Sistema PETSHOP - Cadastros" ;
FROM 10, 10 TO 500, 700 PIXEL ;
MENU BuildMenu()
ACTIVATE WINDOW oWnd MAXIMIZED
RETURN nil
//----------------------------------------------------------------------------//
STATIC FUNCTION BuildMenu()
LOCAL oMenu
MENU oMenu
MENUITEM "Cadastros"
MENU
MENUITEM "Espécies" ACTION CadEspecie()
MENUITEM "Raças" ACTION CadRaca()
MENUITEM "Médicos/Veterinários" ACTION CadVeterinario()
SEPARATOR
MENUITEM "Sair" ACTION oWnd:End()
ENDMENU
ENDMENU
RETURN oMenu
//----------------------------------------------------------------------------//
?? Funções Auxiliares ( OPCIONAIS )
?? PESQUISA.PRG ( Pesquisa de Espécies/Raças )
xbase
//----------------------------------------------------------------------------//
// Função para pesquisar espécie e retornar ID
//----------------------------------------------------------------------------//
FUNCTION PesquisarEspecie()
LOCAL oDlg, oBrw
LOCAL nIDRet := 0
IF !File( "ESPECIE.DBF" )
MsgStop( "Cadastro de espécies não encontrado!" )
RETURN 0
ENDIF
USE Especie shared NEW
IF !used()
RETURN 0
ENDIF
SET ORDER TO 2 // Por descrição
dbGoTop()
DEFINE DIALOG oDlg TITLE "Pesquisar Espécie" FROM 10, 10 TO 400, 500 PIXEL
@ 10, 10 SAY "Digite a descrição:" SIZE 100, 20 PIXEL OF oDlg
@ 10, 120 GET oGetPesq VAR cPesq SIZE 200, 24 PIXEL OF oDlg
@ 40, 10 LISTBOX oBrw FIELDS Especie->ID, Especie->DESCRICAO ;
HEADERS "Código", "Descrição" ;
SIZES 80, 250 ;
SIZE 450, 250 PIXEL OF oDlg
@ 310, 100 BTNBTN oBtnSelecionar PROMPT "Selecionar" SIZE 100, 35 PIXEL OF oDlg ;
ACTION ( nIDRet := Especie->ID, oDlg:End() )
@ 310, 220 BTNBTN oBtnCancelar PROMPT "Cancelar" SIZE 100, 35 PIXEL OF oDlg ;
ACTION ( oDlg:End() )
ACTIVATE DIALOG oDlg CENTERED
USE
RETURN nIDRet
//----------------------------------------------------------------------------//
?? Diagrama de Relacionamento
TEXT
+- ------------ + +- ------------ +
¦ ESPECIE ¦ ¦ RACA ¦
+- ------------¦ +- ------------¦
¦ ID ( PK ) ¦?-------- - ¦ ID_ESPECIE ¦
¦ DESCRICAO ¦ ¦ ID ( PK ) ¦
¦ OBSERVACAO ¦ ¦ DESCRICAO ¦
¦ ATIVO ¦ ¦ PORTE ¦
+- ------------ + ¦ PELO ¦
¦ OBSERVACAO ¦
¦ ATIVO ¦
+- ------------ +
?? Observações Importantes
Relacionamento: O campo ID_ESPECIE em RACA.DBF é a chave estrangeira PARA ESPECIE.DBF
Validações:
Não permite excluir espécie com raças vinculadas
Campos obrigatórios validados
Combos: Os combos de espécie, porte e pelo facilitam a padronização
Exclusão Lógica: Todas as exclusões são lógicas ( campo ATIVO )
Índices: Criados automaticamente PARA performance
?? Como Usar
Compile todos os PRGs
Execute o programa principal
Acesse o MENU Cadastros ? Espécies ou Raças
Utilize os botões PARA navegar, incluir, alterar ou excluir
Precisa de adaptações ou tem dúvidas sobre alguma parte específica? É só perguntar! ??Regards, saludos.