Estimado FiveTech AI, ¿podrías detectar los errores que cometí en este módulo (.PRG) diseñado para controlar los boxes o habitaciones destinados al alojamiento de caninos y felinos? Agradecido de antemano.
// MODULO: CAD_BAIA.PRG
#Include "Fivewin.Ch" // TODOS ESTES INCLUDES, ESTÃO EM UM UNICO ARQUIVO.CH
#Include "Objects.Ch"
#Include "Colores.ch"
#Include "Colors2.ch"
#Include "AnimaBmp.Ch"
#Include "dbinfo.ch"
#Include "Dll.ch"
#Include "Struct.ch"
#Include "dtpicker.ch"
#Include "Directry.ch"
#Include "DSay.Ch"
#include "Fileio.ch"
#Include "GIF.Ch"
#Include "Image.ch"
#Include "Mail.Ch"
#Include "Ord.Ch"
#Include "Report.Ch"
#Include "SSay.Ch"
#Include "URLLink.ch"
#Include "xBrowse.ch"
#Include "hbcompat.ch"
#include "winapi.ch"
#include "XBrowse.ch"
#Include "FGet.ch"
FUNCTION Cad_Baia()
LOCAL oEditarF, oEditarT, oExcluir, oImprimir, oPrioriza, oSaida, iDcor
LOCAL oDlg, oBrw, oFont, oFontBold, oIco, oLimpar, oInfo
LOCAL oRadio, oCmbPorte, oGetBusca
LOCAL nFiltroStatus := 1 // 1=Todas, 2=Livres, 3=Ocupadas, 4=Manutencao
LOCAL cPorte := "TODOS"
LOCAL cBusca := Space( 30 )
LOCAL aPortes := { "TODOS", "PEQUENO", "MEDIO", "GRANDE", "GIGANTE" }
// Verifica e cria DBF nativo e indices caso nao existam
CriaDbfBaias()
// Abertura nativa compartilhada
USE BAIAS INDEX BAIAS SHARED NEW ALIAS BAIAS
IF !File( "BAIAS.CDX" )
CriaIndices()
ENDIF
SET INDEX TO BAIAS
SET ORDER TO TAG NUMERO
DBGOTOP()
DEFINE FONT oFont NAME "Segoe UI" SIZE 0, -12 BOLD
DEFINE FONT oFontBold NAME "Segoe UI" SIZE 0, -14 BOLD
DEFINE ICON oIco RESOURCE "ICONE01" // EM IMAGENS.RES
// Carrega a Dialog Principal desenhada no Borland Workshop
DEFINE DIALOG oDlg RESOURCE "DLG_BAIAS_MAIN" ICON oIco ;
TITLE "Controle de Baias / Boxes / Quartos - Hospedagem PetShop"
oDlg:lHelpIcon := .F.
REDEFINE GROUP oGroup ID 501 OF oDlg COLOR METRO_TURQUE, METRO_ORANGE FONT oFont TRANSPARENT
For iDcor=401 to 402
REDEFINE SAY ID iDcor OF oDlg ;
COLOR METRO_TURQUE, CLR_WHITE UPDATE FONT oFont TRANSPARENT
Next iDcor // By Ednaldo Rolim - Yes!
// -------------------------------------------------------------------------
// 1. CONTROLES DE FILTRO RAPIDO (TOPO DA TELA)
// -------------------------------------------------------------------------
REDEFINE RADIO oRadio VAR nFiltroStatus ID 201, 202, 203, 204 OF oDlg ;
ON CHANGE ( AplicaFiltro( nFiltroStatus, cPorte, oBrw ) )
oRadio:SetFont( oFont )
oRadio:aItems[1]:cTooltip := "Por Todas "
oRadio:aItems[2]:cTooltip := "Por Livres"
oRadio:aItems[3]:cTooltip := "Por Ocupadass "
oRadio:aItems[4]:cTooltip := "Por Manutenção"
REDEFINE COMBOBOX oCmbPorte VAR cPorte ITEMS aPortes ID 205 OF oDlg ;
ON CHANGE ( AplicaFiltro( nFiltroStatus, cPorte, oBrw ) )
oCmbPorte:SetFont( oFont )
REDEFINE GET oGetBusca VAR cBusca ID 206 OF oDlg ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE ;
VALID ( BuscaRapida( cBusca, oBrw ), .T. )
oGetBusca:cToolTip := "Busca as Baias"
REDEFINE BUTTON oLimpar ID 207 OF oDlg ;
ACTION ( LimparFiltros( oRadio, oCmbPorte, oGetBusca, oBrw, @nFiltroStatus, @cPorte, @cBusca ) )
SET FONT OF oLimpar TO oFontBold
REDEFINE BUTTON oInfo ID 208 OF oDlg ;
ACTION MsgInfo( "DICAS DO CADASTRO DE BAIAS:" + CRLF + CRLF + ;
"- Clique nos Radios para filtrar Livres/Ocupadas instantaneamente." + CRLF + ;
"- 'Livres 1' reordena trazendo as vagas livres para o topo." + CRLF + ;
"- Duplo-Clique ou ENTER altera a baia selecionada." + CRLF + ;
"- Tecla INSERT inclui nova baia / Tecla DELETE exclui." + CRLF + ;
"- Banco de dados 100% nativo DBF/CDX.", "Ajuda do Sistema" )
SET FONT OF oInfo TO oFontBold
// -------------------------------------------------------------------------
// 2. CONFIGURACAO DO XBROWSE VINCULADO AO RECURSO ID 101 DO WORKSHOP
// -------------------------------------------------------------------------
REDEFINE XBROWSE oBrw ID 101 OF oDlg ;
COLUMNS "NUMERO", "DESCRICAO", "ESPECIE", "TAMANHO", "STATUS", "VALOR_DIA", "PET_NOME", "TUTOR" ;
HEADERS "Baia/Box:", "Identificação / Nome:", "Espécie:", "Porte Pet:", "Status:", "Diária R$:", "Pet Hospedado:", "Tutor / Fone:" ;
SIZES 90, 220, 90, 90, 120, 120, 120, 500 ;
JUSTIFY AL_CENTER, AL_LEFT, AL_LEFT, AL_LEFT, AL_CENTER, AL_RIGHT, AL_LEFT, AL_LEFT ;
ALIAS "BAIAS" AUTOSORT LINES CELL
WITH OBJECT oBrw
// Configuração Básica
:nMarqueeStyle := MARQSTYLE_HIGHLROW // Ou MARQSTYLE_HIGHLWIN7
:nColDividerStyle := LINESTYLE_LIGHTGRAY
:nRowDividerStyle := LINESTYLE_LIGHTGRAY
:lHScroll := .T.
:lVScroll := .T.
:lRecordSelector := .T.
// Efeito Zebrado (Linhas Normais)
// Usamos OrdKeyNo() para contar a posição lógica no índice - COLORS2.CH
:bClrStd := { || { CLR_BLACK, IF( OrdKeyNo() % 2 == 0, CLR_BLUE_LIGHT, CLR_BLUE_LIGHT_CYAN ) } }
// Efeito ao Selecionar (Foco) CLR_MSPURPLE nRGB( 000, 120, 215 ) //-> Purpura.
// Mantém a cor da fonte branca e fundo azul escuro
:bClrSel := { || { CLR_WHITE, CLR_MSPURPLE } }
// Opcional: Efeito ao Selecionar sem Foco
:bClrSelFocus := { || { CLR_BLACK, CLR_DARK_TEXT } } // COLORS2.CH
END
// Formatacao da coluna de Status com Cores e Nomes Amigaveis
WITH OBJECT oBrw:oCol( "Status" )
:bStrData := { || IF( BAIAS->STATUS == "L", "LIVRE", ;
IF( BAIAS->STATUS == "O", "OCUPADO", "MANUTENÇÃO" ) ) }
:bClrStd := { || { IF( BAIAS->STATUS == "L", CLR_DGREEN, ;
IF( BAIAS->STATUS == "O", CLR_DRED, CLR_DORANGE ) ), ;
IF( BAIAS->STATUS == "L", CLR_LGREEN, ;
IF( BAIAS->STATUS == "O", CLR_LRED, CLR_LYELLOW ) ) } }
END
// Formatacao de Valor de Diaria
WITH OBJECT oBrw:oCol( "Diária R$:" )
:cEditPicture := "@E 9,999.99"
END
// Totalizadores no rodape do XBrowse
oBrw:lFooter := .T.
oBrw:aCols[ 1 ]:bFooter := { || "Total: " + AllTrim( Str( ContarBaias( "T" ) ) ) }
oBrw:aCols[ 2 ]:bFooter := { || "Livres: " + AllTrim( Str( ContarBaias( "L" ) ) ) + ;
" | Ocupadas: " + AllTrim( Str( ContarBaias( "O" ) ) ) + ;
" | Manut: " + AllTrim( Str( ContarBaias( "M" ) ) ) }
// Acoes de teclado e mouse
oBrw:bLDblClick := { || BaiaEditar( .F., oBrw ) }
oBrw:bKeyDown := { | nKey | IF( nKey == VK_RETURN, ( BaiaEditar( .F., oBrw ), 0 ), ;
IF( nKey == VK_INSERT, ( BaiaEditar( .T., oBrw ), 0 ), ;
IF( nKey == VK_DELETE, ( BaiaExcluir( oBrw ), 0 ), NIL ) ) ) }
// -------------------------------------------------------------------------
// 3. BOTOES DE ACAO INFERIORES (CRUD + IMPRIMIR + SAIDA)
// -------------------------------------------------------------------------
REDEFINE BUTTON oEditarT ID 301 OF oDlg ;
ACTION ( BaiaEditar( .T., oBrw ), oBrw:SetFocus() )
oEditarT:cToolTip := "Editar/Incluir Baias"
REDEFINE BUTTON oEditarF ID 302 OF oDlg ;
ACTION ( BaiaEditar( .F., oBrw ), oBrw:SetFocus() )
oEditarF:cToolTip := "Editar/Alterar Baias"
REDEFINE BUTTON oExcluir ID 303 OF oDlg ;
ACTION ( BaiaExcluir( oBrw ), oBrw:SetFocus() )
oExcluir:cToolTip := "Excluir Baias"
REDEFINE BUTTON oImprimir ID 304 OF oDlg WHEN( .F. ) ;
ACTION ( BaiaImprimir( oBrw ), oBrw:SetFocus() )
oImprimir:cToolTip := "Imprimir o Cadastro de Baias"
REDEFINE BUTTON oPrioriza ID 305 OF oDlg ;
ACTION ( PriorizaLivres( oBrw ), oBrw:SetFocus() )
oPrioriza:cToolTip := "Refresh() Geral nas baias Livres"
REDEFINE BUTTON oSaida ID 306 OF oDlg ACTION oDlg:End() CANCEL
oSaida:cToolTip := "Saida - Exit - Cancelar"
SET FONT OF oEditarT TO oFontBold
SET FONT OF oEditarF TO oFontBold
SET FONT OF oExcluir TO oFontBold
SET FONT OF oImprimir TO oFontBold
SET FONT OF oPrioriza TO oFontBold
SET FONT OF oSaida TO oFontBold
// ACTIVATE DIALOG oDlg CENTERED ON INIT( oBrw:SetFocus() )
ACTIVATE DIALOG oDlg ON INIT( CTRLS_COLORS( oDlg ), oBrw:SetFocus() )
// Encerramento ordenado
RELEASE FONT oFont, oFontBold
CLOSE BAIAS
RETURN NIL
// ----------------------------------------------------------------------------
// APLICACAO DE FILTROS NATIVOS (STATUS + PORTE DO PET)
// ----------------------------------------------------------------------------
STATIC FUNCTION AplicaFiltro( nOpcStatus, cPorte, oBrw )
LOCAL cFiltro := ""
IF nOpcStatus == 2 // Livres
cFiltro := 'STATUS == "L"'
ELSEIF nOpcStatus == 3 // Ocupadas
cFiltro := 'STATUS == "O"'
ELSEIF nOpcStatus == 4 // Manutencao
cFiltro := 'STATUS == "M"'
ENDIF
IF !Empty( cPorte ) .AND. AllTrim( cPorte ) != "TODOS"
IF !Empty( cFiltro )
cFiltro += ' .AND. '
ENDIF
cFiltro += 'AllTrim( Upper( TAMANHO ) ) == "' + ALLTRIM( UPPER( cPorte ) ) + '"'
ENDIF
IF Empty( cFiltro )
DbClearFilter()
ELSE
SET FILTER TO &cFiltro
ENDIF
DBGOTOP()
oBrw:Refresh()
RETURN NIL
// ----------------------------------------------------------------------------
// LIMPEZA GERAL DE FILTROS E PESQUISAS
// ----------------------------------------------------------------------------
STATIC FUNCTION LimparFiltros( oRadio, oCmbPorte, oGetBusca, oBrw, nFiltroStatus, cPorte, cBusca )
nFiltroStatus := 1
oRadio:SetOption( 1 )
cPorte := "TODOS"
oCmbPorte:Set( 1 )
cBusca := Space( 30 )
oGetBusca:Refresh()
DbClearFilter()
SET ORDER TO TAG NUMERO
DBGOTOP()
oBrw:Refresh()
oBrw:SetFocus()
RETURN NIL
// ----------------------------------------------------------------------------
// BUSCA RAPIDA INCREMENTAL / NATIVA
// ----------------------------------------------------------------------------
STATIC FUNCTION BuscaRapida( cTexto, oBrw )
LOCAL cTermo := Upper( AllTrim( cTexto ) )
IF Empty( cTermo )
DBGOTOP()
oBrw:Refresh()
RETURN NIL
ENDIF
// Se for codigo numerico, pesquisa no indice de codigo
IF IsDigit( Left( cTermo, 1 ) )
SET ORDER TO TAG NUMERO
SEEK PadR( cTermo, 6 )
IF !Found()
SEEK cTermo
ENDIF
ELSE
// Pesquisa por nome / descricao
SET ORDER TO TAG DESCR
SEEK cTermo
ENDIF
oBrw:Refresh()
RETURN NIL
// ----------------------------------------------------------------------------
// ORDENACAO: LIVRES PRIMEIRO (SEM ESCONDER OS DEMAIS)
// ----------------------------------------------------------------------------
STATIC FUNCTION PriorizaLivres( oBrw )
SET ORDER TO TAG STATUSNUM
DBGOTOP()
oBrw:Refresh()
MsgInfo( "As baias livres foram posicionadas no topo da lista!", ;
"Organizacao Rapida" )
RETURN NIL
// ----------------------------------------------------------------------------
// TELA DE EDICAO (INCLUSAO E ALTERACAO) VIA RECURSO DO WORKSHOP
// ----------------------------------------------------------------------------
STATIC FUNCTION BaiaEditar( lInclusao, oBrw )
LOCAL oDlgEd, oNum, oDesc, oCmbEsp, oCmbTam, oCmbSt, oVal, oPet, oTut, oObs
LOCAL oObs2, oObs3, oObs4, oObs5, oObs6
LOCAL oBtnGravar, oBtnCancelar, nNum, oGroup, oGroup2, oFnt, oFont, oIco
LOCAL cNum // := Space( 6 )
LOCAL cDesc // := Space( 35 )
LOCAL cEsp // := "AMBOS"
LOCAL cTam // := "MEDIO"
LOCAL cStCombo // := "L - LIVRE"
LOCAL nVal // := 70.00
LOCAL cPet // := Space( 25 )
LOCAL cTut // := Space( 30 )
LOCAL cObs, cObs2, cObs3, cObs4, cObs5, cObs6
LOCAL lSalvo := .F.
LOCAL aEspecies := { "AMBOS", "CAO", "GATO" }
LOCAL aTamanhos := { "PEQUENO", "MEDIO", "GRANDE", "GIGANTE", "TODOS" }
LOCAL aStatus := { "L - LIVRE", "O - OCUPADO", "M - MANUTENCAO" }
IF( .NOT. lInclusao ) // alteracao
IF BAIAS->( Eof() )
MsgAlert( "não há registro selecionado para Alteração!", "Atenção" )
RETURN NIL
ENDIF
// Carrega dados nativos do DBF atual
cNum := BAIAS->NUMERO
cDesc := BAIAS->DESCRICAO
cEsp := Upper( AllTrim( BAIAS->ESPECIE ) )
cTam := Upper( AllTrim( BAIAS->TAMANHO ) )
nVal := BAIAS->VALOR_DIA
cPet := BAIAS->PET_NOME
cTut := BAIAS->TUTOR
cObs := BAIAS->OBS
cObs2 := BAIAS->OBS2
cObs3 := BAIAS->OBS3
cObs4 := BAIAS->OBS4
cObs5 := BAIAS->OBS5
cObs6 := BAIAS->OBS6
IF BAIAS->STATUS == "L"
cStCombo := "L - LIVRE"
ELSEIF BAIAS->STATUS == "O"
cStCombo := "O - OCUPADO"
ELSE
cStCombo := "M - MANUTENCAO"
ENDIF
ELSE // inclusao
cNum := 0 //Space( 6 ) PASSEI A NUMERICO
GO BOTTOM
nNum := ( BAIAS->NUMERO ) + 1
cNum := nNum
cDesc := Space( 35 )
cEsp := "AMBOS"
cTam := "MEDIO"
cStCombo := "L - LIVRE"
nVal := 0 // 70.00
cPet := Space( 25 )
cTut := Space( 30 )
cObs := Space( 50 )
cOBS2 := Space( 50 )
cOBS3 := Space( 50 )
cOBS4 := Space( 50 )
cOBS5 := Space( 50 )
cOBS6 := Space( 50 )
GO TOP
ENDIF
DEFINE FONT oFnt NAME "Ms Sans Serif" SIZE 0, -12 BOLD
DEFINE FONT oFont NAME "Ms Sans Serif" SIZE 0, -14 BOLD
DEFINE ICON oIco RESOURCE "ICONE01" // EM IMAGENS.RES
DEFINE DIALOG oDlgEd RESOURCE "DLG_CADASTRO_BAIA" ICON oIco ;
TITLE IF( lInclusao, "Inclusao de Baia / Box / Quarto", ;
"Alteracao de Baia / Box / Quarto" )
oDlgEd:lHelpIcon := .F.
REDEFINE GROUP oGroup ID 501 OF oDlgEd COLOR METRO_TURQUE, CLR_WHITE FONT oFnt TRANSPARENT
REDEFINE GROUP oGroup2 ID 502 OF oDlgEd COLOR METRO_TURQUE, CLR_WHITE FONT oFnt TRANSPARENT
For iDcor=401 to 409
REDEFINE SAY ID iDcor OF oDlgEd ;
COLOR METRO_TURQUE, CLR_WHITE UPDATE FONT oFont TRANSPARENT
Next iDcor // By Ednaldo Rolim - Yes!
// Controles mapeados aos IDs da DLG_CADASTRO_BAIA do Workshop
REDEFINE GET oNum VAR cNum ID 111 OF oDlgEd PICTURE "@K 999999" ;
WHEN( lInclusao ) FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE ;
VALID( VERIFICA_NUM_BAIA( lInclusao, cNum ) )
REDEFINE GET oDesc VAR cDesc ID 112 OF oDlgEd PICTURE "@!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE COMBOBOX oCmbEsp VAR cEsp ITEMS aEspecies ID 113 OF oDlgEd
oCmbEsp:SetFont( oFont )
REDEFINE COMBOBOX oCmbTam VAR cTam ITEMS aTamanhos ID 114 OF oDlgEd
oCmbTam:SetFont( oFont )
REDEFINE COMBOBOX oCmbSt VAR cStCombo ITEMS aStatus ID 115 OF oDlgEd
oCmbSt:SetFont( oFont )
REDEFINE GET oVal VAR nVal ID 116 OF oDlgEd PICTURE "@KE 99,999.99" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oPet VAR cPet ID 117 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oTut VAR cTut ID 118 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs VAR cObs ID 119 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs2 VAR cObs2 ID 120 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs3 VAR cObs3 ID 121 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs4 VAR cObs4 ID 122 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs5 VAR cObs5 ID 123 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
REDEFINE GET oObs6 VAR cObs6 ID 124 OF oDlgEd PICTURE "@KR!" ;
FONT oFont UPDATE COLORS CLR_BLACK, CLR_WHITE
// Botoes de Acao da Dialog de Edicao
REDEFINE BUTTON oBtnGravar ID 301 OF oDlgEd ;
ACTION ( lSalvo := BaiaGravar( lInclusao, cNum, cDesc, cEsp, cTam, Left( cStCombo, 1 ), ;
nVal, cPet, cTut, cObs, cObs2, cObs3, cObs4, cObs5, cObs6, oDlgEd, oBrw ) )
REDEFINE BUTTON oBtnCancelar ID 302 OF oDlgEd ACTION oDlgEd:End() CANCEL
SET FONT OF oBtnGravar TO oFont
SET FONT OF oBtnCancelar TO oFont
ACTIVATE DIALOG oDlgEd CENTERED ON INIT( CTRLS_COLORS( oDlgEd ) ) // FUNCOES.PRG
RETURN NIL
FUNCTION VERIFICA_NUM_BAIA( lInclusao, nNumBaia )
IF lInclusao
// Validacao nativa com SEEK para evitar duplicidade de codigo
SET ORDER TO TAG NUMERO
DBSEEK( nNumBaia )
IF FOUND()
MsgStop( "já existe uma baia cadastrada com o numero: " + STR( nNumBaia ), "Atenção" )
RETURN( .F. )
ENDIF
ENDIF
RETURN( .T. )
// ----------------------------------------------------------------------------
// GRAVACAO NATIVA NO BANCO DBF
// ----------------------------------------------------------------------------
STATIC FUNCTION BaiaGravar( lInclusao, cNum, cDesc, cEsp, cTam, cStatus, ;
nVal, cPet, cTut, cObs, cObs2, cObs3, ;
cObs4, cObs5, cObs6, oDlgEd, oBrw )
IF Empty( cNum )
MsgStop( "O codigo/numero da baia e obrigatorio!", "Aviso" )
RETURN( .F. )
ENDIF
IF Empty( cDesc )
MsgStop( "A descricao/identificacao da baia e obrigatoria!", "Aviso" )
RETURN( .F. )
ENDIF
IF lInclusao
// Validacao nativa com SEEK para evitar duplicidade de codigo
SET ORDER TO TAG NUMERO
DBSEEK( cNum )
IF Found()
MsgStop( "já existe uma baia cadastrada com o numero: " + STR( cNum ), "Atenção" )
RETURN( .F. )
ENDIF
// Comando nativo de inclusao
APPEND BLANK
IF NetErr()
MsgStop( "Falha de rede ao incluir o registro!", "Erro de Gravação" )
RETURN( .F. )
ENDIF
ELSE
// Bloqueio seguro para alteracao em rede
IF !RLock()
MsgStop( "O registro esta sendo editado por outro usuario na rede!", "Bloqueio" )
RETURN( .F. )
ENDIF
ENDIF
// Gravacao nativa campo a campo
REPLACE FIELD->NUMERO WITH cNum, ;
FIELD->DESCRICAO WITH cDesc, ;
FIELD->ESPECIE WITH cEsp, ;
FIELD->TAMANHO WITH cTam, ;
FIELD->STATUS WITH cStatus, ;
FIELD->VALOR_DIA WITH nVal, ;
FIELD->PET_NOME WITH cPet, ;
FIELD->TUTOR WITH cTut, ;
FIELD->OBS WITH cObs, ;
FIELD->OBS2 WITH cObs2, ;
FIELD->OBS3 WITH cObs3, ;
FIELD->OBS4 WITH cObs4, ;
FIELD->OBS5 WITH cObs5, ;
FIELD->OBS6 WITH cObs6
DBUNLOCK()
DBCOMMIT()
GRAVACAO_EFETUADA_COM_SUCESSO()
oBrw:Refresh()
oDlgEd:End()
RETURN .T.
// ----------------------------------------------------------------------------
// EXCLUSAO NATIVA DE REGISTRO
// ----------------------------------------------------------------------------
STATIC FUNCTION BaiaExcluir( oBrw )
IF BAIAS->( Eof() )
MsgAlert( "Nenhum registro selecionado para exclusao!", "Aviso" )
RETURN NIL
ENDIF
IF MsgNoYes( "Deseja realmente excluir a Baia: " + AllTrim( BAIAS->NUMERO ) + ;
" (" + AllTrim( BAIAS->DESCRICAO ) + ")?", "Confirmacao de Exclusao" )
IF RLock()
DELETE
DBUNLOCK()
DBCOMMIT()
DBSKIP( 1 )
IF Eof()
DBGOBOTTOM()
ENDIF
oBrw:Refresh()
MsgInfo( "Baia excluida com sucesso!", "Operacao Concluida" )
ELSE
MsgStop( "Registro travado na rede. Nao foi possivel excluir agora.", "Erro" )
ENDIF
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------
// IMPRESSAO DO RELATORIO DE BAIAS E OCUPACAO VIA TPRINTER / PREVIEW
// ----------------------------------------------------------------------------
STATIC FUNCTION BaiaImprimir( oBrw )
LOCAL oPrn, oFontTit, oFontCab, oFontSub, oFontDet, oFontTot
LOCAL nLinha := 1.0
LOCAL nRecAtual := BAIAS->( RecNo() )
LOCAL nTotBaias := 0, nTotLivres := 0, nTotOcup := 0, nTotManut := 0
PRINT oPrn NAME "Relatorio de Baias e Quartos - PetShop" PREVIEW
DEFINE FONT oFontTit NAME "Arial" SIZE 0, -14 BOLD OF oPrn
DEFINE FONT oFontSub NAME "Arial" SIZE 0, -10 OF oPrn
DEFINE FONT oFontCab NAME "Courier New" SIZE 0, -10 BOLD OF oPrn
DEFINE FONT oFontDet NAME "Courier New" SIZE 0, -9 OF oPrn
DEFINE FONT oFontTot NAME "Courier New" SIZE 0, -10 BOLD OF oPrn
PAGE
// Cabecalho
oPrn:Say( nLinha, 1.0, "PETSHOP HOTEL & HOSPEDAGEM - CONTROLE DE BAIAS/BOXES", oFontTit )
nLinha += 0.5
oPrn:Say( nLinha, 1.0, "Emissao: " + DToC( Date() ) + " as " + Time() + " | Filtro Atual: Ativo", oFontSub )
nLinha += 0.5
oPrn:Say( nLinha, 1.0, Replicate( "=", 110 ), oFontCab )
nLinha += 0.4
oPrn:Say( nLinha, 1.0, "NUM IDENTIFICACAO/NOME ESPECIE PORTE STATUS DIARIA R$ PET HOSPEDADO / TUTOR", oFontCab )
nLinha += 0.35
oPrn:Say( nLinha, 1.0, Replicate( "-", 110 ), oFontCab )
nLinha += 0.45
BAIAS->( DBGOTOP() )
DO WHILE !BAIAS->( Eof() )
IF !Deleted()
nTotBaias++
IF BAIAS->STATUS == "L"
nTotLivres++
ELSEIF BAIAS->STATUS == "O"
nTotOcup++
ELSE
nTotManut++
ENDIF
oPrn:Say( nLinha, 1.0, BAIAS->NUMERO, oFontDet )
oPrn:Say( nLinha, 1.8, Left( BAIAS->DESCRICAO, 28 ), oFontDet )
oPrn:Say( nLinha, 4.6, Left( BAIAS->ESPECIE, 8 ), oFontDet )
oPrn:Say( nLinha, 5.6, Left( BAIAS->TAMANHO, 9 ), oFontDet )
oPrn:Say( nLinha, 6.7, IF( BAIAS->STATUS == "L", "LIVRE", IF( BAIAS->STATUS == "O", "OCUPADO", "MANUT." ) ), oFontDet )
oPrn:Say( nLinha, 7.8, Transform( BAIAS->VALOR_DIA, "@E 9,999.99" ), oFontDet )
oPrn:Say( nLinha, 9.0, AllTrim( BAIAS->PET_NOME ) + IF( !Empty( BAIAS->TUTOR ), " (" + AllTrim( BAIAS->TUTOR ) + ")", "" ), oFontDet )
nLinha += 0.40
// Quebra de pagina se ultrapassar limite
IF nLinha > 26.5
oPrn:EndPage()
oPrn:StartPage()
nLinha := 1.5
ENDIF
ENDIF
BAIAS->( DBSKIP() )
ENDDO
// Resumo Totalizador
nLinha += 0.2
oPrn:Say( nLinha, 1.0, Replicate( "=", 110 ), oFontCab )
nLinha += 0.45
oPrn:Say( nLinha, 1.0, "RESUMO GERAL: " + ;
"Total de Baias: " + AllTrim( Str( nTotBaias ) ) + " | " + ;
"Livres: " + AllTrim( Str( nTotLivres ) ) + " | " + ;
"Ocupadas: " + AllTrim( Str( nTotOcup ) ) + " | " + ;
"Em Manutencao: " + AllTrim( Str( nTotManut ) ), oFontTot )
ENDPAGE
ENDPRINT
RELEASE FONT oFontTit, oFontSub, oFontCab, oFontDet, oFontTot
// Restaura posicao original do cursor no DBF
BAIAS->( DBGOTO( nRecAtual ) )
oBrw:Refresh()
RETURN NIL
// ----------------------------------------------------------------------------
// CONTAGEM ESTATISTICA NATIVA DE BAIAS
// ----------------------------------------------------------------------------
STATIC FUNCTION ContarBaias( cTipo )
LOCAL nQtd := 0
LOCAL nSalvaRec := BAIAS->( RecNo() )
BAIAS->( DBGOTOP() )
DO WHILE !BAIAS->( Eof() )
IF !Deleted()
IF cTipo == "T"
nQtd++
ELSEIF BAIAS->STATUS == cTipo
nQtd++
ENDIF
ENDIF
BAIAS->( DBSKIP() )
ENDDO
BAIAS->( DBGOTO( nSalvaRec ) )
RETURN nQtd
// ----------------------------------------------------------------------------
// ESTRUTURA E CARGA INICIAL DO BANCO DBF NATIVO
// ----------------------------------------------------------------------------
STATIC FUNCTION CriaDbfBaias()
LOCAL aStruct := {}
IF !File( "BAIAS.DBF" )
AAdd( aStruct, { "NUMERO", "N", 6, 0 } ) // Codigo/Numero da baia
AAdd( aStruct, { "DESCRICAO", "C", 40, 0 } ) // Nome do quarto/box
AAdd( aStruct, { "ESPECIE", "C", 25, 0 } ) // CAO, GATO, AMBOS
AAdd( aStruct, { "TAMANHO", "C", 15, 0 } ) // PEQUENO, MEDIO, GRANDE, GIGANTE
AAdd( aStruct, { "STATUS", "C", 1, 0 } ) // L=Livre, O=Ocupado, M=Manutencao
AAdd( aStruct, { "VALOR_DIA", "N", 9, 2 } ) // Diaria R$
AAdd( aStruct, { "PET_NOME", "C", 40, 0 } ) // Nome do Pet se ocupado
AAdd( aStruct, { "TUTOR", "C", 60, 0 } ) // Nome e fone do tutor
AAdd( aStruct, { "OBS", "C", 50, 0 } ) // Recursos da baia (ar, camera)
AAdd( aStruct, { "OBS2", "C", 50, 0 } ) // Recursos da baia (ar, camera)
AAdd( aStruct, { "OBS3", "C", 50, 0 } ) // Recursos da baia (ar, camera)
AAdd( aStruct, { "OBS4", "C", 50, 0 } ) // Recursos da baia (ar, camera)
AAdd( aStruct, { "OBS5", "C", 50, 0 } ) // Recursos da baia (ar, camera)
AAdd( aStruct, { "OBS6", "C", 50, 0 } ) // Recursos da baia (ar, camera)
DBCREATE( "BAIAS.DBF", aStruct, "DBFCDX" )
// Pre-popula com dados iniciais de exemplo realistas
USE BAIAS EXCLUSIVE NEW VIA "DBFCDX"
CriaIndices()
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000001" ), ;
FIELD->DESCRICAO WITH "BOX VIP CANIL OURO 01", ;
FIELD->ESPECIE WITH "CAO", ;
FIELD->TAMANHO WITH "GRANDE", ;
FIELD->STATUS WITH "L", ;
FIELD->VALOR_DIA WITH 95.00, ;
FIELD->OBS WITH "Solario individual, camera HD e ar condicionado"
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000002" ), ;
FIELD->DESCRICAO WITH "BOX CANIL MASTER 02", ;
FIELD->ESPECIE WITH "CAO", ;
FIELD->TAMANHO WITH "MEDIO", ;
FIELD->STATUS WITH "O", ;
FIELD->VALOR_DIA WITH 75.00, ;
FIELD->PET_NOME WITH "THOR (GOLDEN)", ;
FIELD->TUTOR WITH "MARCELO SILVA (11) 98888-1234", ;
FIELD->OBS WITH "Racao especial as 18h"
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000003" ), ;
FIELD->DESCRICAO WITH "SUITE FELINA FELIX 01", ;
FIELD->ESPECIE WITH "GATO", ;
FIELD->TAMANHO WITH "PEQUENO", ;
FIELD->STATUS WITH "L", ;
FIELD->VALOR_DIA WITH 65.00, ;
FIELD->OBS WITH "Arranhadores verticais e prateleiras suspensas"
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000004" ), ;
FIELD->DESCRICAO WITH "SUITE FELINA FELIX 02", ;
FIELD->ESPECIE WITH "GATO", ;
FIELD->TAMANHO WITH "PEQUENO", ;
FIELD->STATUS WITH "O", ;
FIELD->VALOR_DIA WITH 65.00, ;
FIELD->PET_NOME WITH "MIA (PERSA)", ;
FIELD->TUTOR WITH "RENATA LIMA (11) 97777-5678", ;
FIELD->OBS WITH "Gata idosa, medicacao as 08h"
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000005" ), ;
FIELD->DESCRICAO WITH "BOX STANDARD 05", ;
FIELD->ESPECIE WITH "AMBOS", ;
FIELD->TAMANHO WITH "PEQUENO", ;
FIELD->STATUS WITH "L", ;
FIELD->VALOR_DIA WITH 55.00, ;
FIELD->OBS WITH "Ideal para caes pequenos ou gatos"
APPEND BLANK
REPLACE FIELD->NUMERO WITH VAL( "000006" ), ;
FIELD->DESCRICAO WITH "QUARTO GIGANTE PRIVATIVO", ;
FIELD->ESPECIE WITH "CAO", ;
FIELD->TAMANHO WITH "GIGANTE", ;
FIELD->STATUS WITH "M", ;
FIELD->VALOR_DIA WITH 120.00, ;
FIELD->OBS WITH "Higienizacao e troca de piso em andamento"
DBCOMMIT()
CLOSE BAIAS
ENDIF
RETURN NIL
// ----------------------------------------------------------------------------
// CRIACAO DE INDICES CDX NATIVOS
// ----------------------------------------------------------------------------
STATIC FUNCTION CriaIndices()
INDEX ON FIELD->NUMERO TAG NUMERO TO BAIAS
INDEX ON FIELD->STATUS TAG STATUS TO BAIAS
INDEX ON FIELD->STATUS + FIELD->NUMERO TAG STATUSNUM TO BAIAS
INDEX ON FIELD->TAMANHO TAG TAMANHO TO BAIAS
INDEX ON Upper( FIELD->DESCRICAO ) TAG DESCR TO BAIAS
RETURN NIL
// ============================================================================
// FIM DO MODULO CAD_BAIA.PRG - kapiabafwh@gmail.com
// ============================================================================Gracias, tks.
Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341