;** Bibliot  *******************************************************************
;*  Biblioteca de Rotinas de Trabalho                                          *
;*******************************************************************************
;Autor           : Vise Informatica (VISERP)
;Desenvolvido    : 05/07/1996 por Anivel Augusto Rodrigues
;Ultima Alteracao: 12/01/2018 por Kamila Gomes
;Motivo Alteracao: Ajustes Sys_Aplicativo para Troca
;Ultima Alteracao: 18/01/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado SYS_CODIGO_CLIENTE="0403" -> PegaCodigoRaiz() 
;Ultima Alteracao: 05/02/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Exclusao Ordem_Report() usar Seta_Ordem_Report()                
;Ultima Alteracao: 08/02/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Adicionado PegaCodigoRaizAteCor()
;Ultima Alteracao: 20/02/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Adicionado novas simbologias textil
;Ultima Alteracao: 01/03/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado Imprime_Simbologia()
;Ultima Alteracao: 07/03/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes Imprime_Simbologia()
;Ultima Alteracao: 15/03/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado SYS_CODIGO_CLIENTE="0408" -> PegaCodigoRaiz()
;Ultima Alteracao: 29/03/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Adicionado Seta_Altura_Report()
;Ultima Alteracao: 05/04/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Adicionado MudaEstruturaDaTabelaPara(), ajuste Adiciona_Campo() Trimming
;Ultima Alteracao: 30/04/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado tamanho Download_Simbologia() no terceiro parƒmetro
;Ultima Alteracao: 11/05/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes funcmd
;Ultima Alteracao: 30/05/2018 por Bruno Carvalho
;Motivo Alteracao: Comentado linhas sem necessidade de implementa‡Æo -> Item_Localizador() 
;Ultima Alteracao: 30/05/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Adiciona_Campo_EmOrdem()
;Ultima Alteracao: 05/06/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado Grava_LogEx()
;Ultima Alteracao: 07/06/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes DispositivoI(),DispositivoEtq() video zebrado
;Ultima Alteracao: 09/06/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes DispositivoI() e-mail TAB/atalho
;Ultima Alteracao: 13/07/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Ordem_Campo_Tabela()
;Ultima Alteracao: 18/07/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() para #0419#
;Ultima Alteracao: 19/07/2018 por Bruno Carvalho
;Motivo Alteracao: Faz a verifica‡Æo se arquivo "arqtxt" existe, para utilizar Append ou criar um arquivo novo 
;Ultima Alteracao: 15/08/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes SetaCor_Sistema() p/ quando SYS_COR="VERMELHO" ->  cccolors[1057] =31 **COR LINHA SELECIONADA NO SHOWDIALOG
;Ultima Alteracao: 21/08/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Verificar_Versao()
;Ultima Alteracao: 31/08/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes ao reportar o erro no ErroValid(), com mais informa‡äes e ajustes no layout de grava‡Æo do arq de erro  
;Ultima Alteracao: 14/09/2017 por Bruno Carvalho
;Motivo Alteracao: CheckTG_OPEMAIL[1]=True p/ #0274#
;Ultima Alteracao: 24/09/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes conta corrente cheque
;Ultima Alteracao: 25/09/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes na mensagem do IsLockRecord() ao travar tentativa em acesso … registro pelo usu rio
;Ultima Alteracao: 27/09/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Implementa‡Æo de envio de romaneio por e-mail para cliente #0380#
;Ultima Alteracao: 05/10/2018 por Kamila Gomes
;Motivo Alteracao: SYS_CODIGO_CLIENTE = "0274" seta CheckTG_OPEMAIL[1] = false
;Ultima Alteracao: 11/10/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes p/ quando utilizar CRIAR_TABELA=True, a tabela ‚ criada e assim add os campos -> Adiciona_Campo()
;Ultima Alteracao: 23/10/2018 por Kamila Gomes
;Motivo Alteracao: SYS_CODIGO_CLIENTE = "0343" seta CheckTG_OPEMAIL[1] = false
;Ultima Alteracao: 24/10/2018 por Bruno Carvalho
;Motivo Alteracao: Comentado processo inserido em 05/10 -> Adiciona_Campo() pois ao gerar EOPAF63 estava tendo problemas, pois a tabela ja estava criada
;Ultima Alteracao: 24/10/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes CriaTabelaControle(),PegaRegistroControle(),AtualizaRegistroControle() chequei
;Ultima Alteracao: 31/10/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes p/ ao gravar um log gen‚rico  -> Grava_LogEx()
;Ultima Alteracao: 06/11/2018 por Anivel Augusto Rodrigues
;Motivo Alteracao: Add Gravar_logerror()
;Ultima Alteracao: 27/11/2018 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() para #0426#
;Ultima Alteracao: 27/12/2018 por Bruno Carvalho
;Motivo Alteracao: Retirado da Trigger "ARRIVE" e "UPDATE" e Key foi retirado "ESC" -> Showfastmsg
;Ultima Alteracao: 27/12/2018 por Bruno Carvalho
;Motivo Alteracao: Adicionado "EVENT" KeyCode=13 para controle das FastMsg ao pressionar ENTER v rias vezes seguidas -> SD_Dialogfastmsg()
;Ultima Alteracao: 28/12/2018 por Anivel Augusto Rodrigues                           
;Motivo Alteracao: Adicionado processos de #0427#
;Ultima Alteracao: 02/01/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado ALV_42 -> Imprime_Simbologia()
;Ultima Alteracao: 08/01/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado "Ativa_CodBar" e "Inativa_CodBar" em Grava_LogEx()
;Ultima Alteracao: 08/01/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes Gravar_logerror()
;Ultima Alteracao: 11/01/2019 por Bruno Carvalho
;Motivo Alteracao: Alterado a cria‡Æo do arquivo LOGERRO p/ ser gerado apenas em seu mˆs atual em que os registros sÆo processados
;Ultima Alteracao: 01/02/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() #0423#
;Ultima Alteracao: 20/02/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes desabilitado formato Dbase/DBF
;Ultima Alteracao: 20/03/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Verifica_CtDia_Modulo()
;Ultima Alteracao: 27/03/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: SYS_CODIGO_CLIENTE = "0431" seta CheckTG_OPEMAIL[1] = true FATURA
;Ultima Alteracao: 29/03/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: SYS_CODIGO_CLIENTE = "0232" seta CheckTG_OPEMAIL[1] = true FATURA/Pedido
;Ultima Alteracao: 05/04/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() #0434#
;Ultima Alteracao: 06/07/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes SYS_Valor()
;Ultima Alteracao: 22/04/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado Grava_LogEx() -> "LPresenC" e "LPresenI"
;Ultima Alteracao: 23/04/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() para #0429#
;Ultima Alteracao: 07/05/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado localiza‡Æo para segundo c¢digo de barras -> ModoLocalizarItem()
;Ultima Alteracao: 07/05/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado "PS_OP", "PS_PG" e "PS_US" em Grava_LogEx()
;Ultima Alteracao: 05/06/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Existe_Cheque() Unlockrecord/lockrecord
;Ultima Alteracao: 12/06/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado Tipo="Editar_Campo" na proc SetaCorRegistro() p/ um modo de paginar somente no campo determinado
;Ultima Alteracao: 13/06/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Existe_Cheque() Unlockrecord/lockrecord
;Ultima Alteracao: 25/06/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado PlContas()
;Ultima Alteracao: 26/06/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes ExisteArquivo()
;Ultima Alteracao: 26/06/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes na proc Adiciona_Campo() -> Foi removido a area comnentada do processo p/ quando CRIAR_TABELA = True 
;                   ** IMP_SITE ** e caso necess rio, criar novos parƒmetros p/ nÆo ser necess rio comentar este processo
;Ultima Alteracao: 26/06/2019 por Anivel Augusto Rodrigues/Kamila Gomes
;Motivo Alteracao: Ajustes ExisteArquivo()
;Ultima Alteracao: 26/06/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado vari vel de controle CRIAR_TABELA2 na proc Cria_Tabela() onde foi necess rio para ajustar a linha comentada Adiciona_Campo() 
;Ultima Alteracao: 28/06/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustes Checa_Supervisor()
;Ultima Alteracao: 28/06/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado "BordChqC" e "BordChqI" em Grava_LogEx()
;Ultima Alteracao: 01/07/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado Array_Monta_Grade_GetRecord() a fim de melhorar o desempenho ao montar a grade do item
;Ultima Alteracao: 02/07/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes "BordChqC" em Grava_LogEx()
;Ultima Alteracao: 02/07/2019 por Bruno Carvalho
;Motivo Alteracao: Alterado [Producao Esgotada] da tabela "Iten_Com" p/ a tabela "Itens" 
;Ultima Alteracao: 05/07/2019 por Kamila Gomes
;Motivo Alteracao: Ajustes Valida_IE 
;Ultima Alteracao: 16/07/2019 por Anivel Augusto Rodrigues
;Motivo Alteracao: Adicionado EstruturaDaTabelaNoKey()
;Ultima Alteracao: 23/07/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado "FaturaC" -> CriaTabelaControle() e ajustes AtualizaRegistroControle()
;Ultima Alteracao: 24/07/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado modelo "PCX_INV" na proc Download_Simbologia() p/ imprimir simbolos inversos *Etq: ET_Z388E 
;Ultima Alteracao: 25/07/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado BloqueiaTabelas() e DesbloqueiaTabelas()
;Ultima Alteracao: 05/08/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes #0227# -> Array_Monta_Grade_GetRecord()
;Ultima Alteracao: 05/08/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado CodigoSimbologiaPorCliente() e "LIMP_46" na proc Imprime_Simbologia()
;Ultima Alteracao: 12/08/2019 por Kamila Gomes
;Motivo Alteracao: Ajuste tempo de espera na proc LerConteudodoArquivo8
;Ultima Alteracao: 14/08/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado "PontoC", "PontoI" e "AltPonto" na Grava_LogEx()
;Ultima Alteracao: 14/08/2019 por Bruno Carvalho
;Motivo Alteracao: Excluido Usuario_Vendedor(), onde foi substituido por Valida_ShowDialog()  *Bib_Show
;Ultima Alteracao: 23/09/2019 por Kamila Gomes
;Motivo Alteracao: Implementa‡Æo da proc ModLocaliza()
;Ultima Alteracao: 28/08/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes p/ nÆo exibir a mensagem ao verificar se apenas uma ref esta inativa -> Array_Monta_Grade_GetRecord()
;Ultima Alteracao: 26/08/2019 por Anivel Augusto Rodrigues/Kamila Gomes
;Motivo Alteracao: Ajustes Existe_Cheque()
;Ultima Alteracao: 26/08/2019 por Anivel Augusto Rodrigues/Kamila Gomes
;Motivo Alteracao: Adicionado Grava_LogEx() acerto financeiro
;Ultima Alteracao: 17/10/2019 por Bruno Carvalho
;Motivo Alteracao: Adicionado Download_Imagem_Termica() **Processo p/ adicioanr logo na impressora termica ZEBRA ou BEMATECH
;Ultima Alteracao: 21/10/2019 por Anivel Augusto Rodrigues/Kamila Gomes
;Motivo Alteracao: Adicionado error 20 para tratamento
;Ultima Alteracao: 21/11/2019 por Anivel Augusto Rodrigues/Kamila Gomes
;Motivo Alteracao: Ajustes "Pedido DesctTot"
;Ultima Alteracao: 06/12/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() para #0419#
;Ultima Alteracao: 06/12/2019 por Bruno Carvalho
;Motivo Alteracao: Ajustes PlContas() p/ informar o tipo de plano de conta
;Ultima Alteracao: 06/12/2019 por Bruno Carvalho
;Motivo Alteracao: Removido proc SD_DialogCampos(), Registrar_Log() e Grava_Log_Exec(), nao foi identificado a sua utiliza‡Æo
;Ultima Alteracao: 24/12/2019 por Bruno Carvalho
;Motivo Alteracao: Movido procs relacionada a baixo para BIB_PROC
;                  Checa_Estado,Verificar_Versao,Verifica_CtDia_Modulo,ModLocaliza,Ler_ModLocaliza,SD_DialogLerModLocaliza,
;                  Consulta_CNPJ,ImagemDir,Leitura_Cheque,Valida_Leitura_Cheque,SD_DialogLerCh,Array_Monta_Grade,
;                  Array_Monta_Grade_GetRecord,Busca_Cep,Verifica_Almoxarifado,Existe_Cheque,Download_Simbologia,
;                  Imprime_Simbologia,CodigoSimbologiaPorCliente,Monta_Opcoes_Cor,Seleciona_Opcoes_Cor,PlContas,
;                  Download_Imagem_Termica,Imprime_Imagem_Termica
;Ultima Alteracao: 03/01/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado "LIMPA_OC" em Grava_LogEx()
;Ultima Alteracao: 07/02/2020 por Anivel Augusto Rodrigues
;Motivo Alteracao: Ajustess [Enter] rodape botoes ok/cancela
;Ultima Alteracao: 13/05/2020 por Bruno Carvalho
;Motivo Alteracao: Ajustes PegaCodigoRaiz() para #0397#
;Ultima Alteracao: 03/07/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado vari vel GERA_ARQUIVO_OCULTO na proc ImpriRel()  
;Ultima Alteracao: 02/09/2020 por Bruno Carvalho
;Motivo Alteracao: Ajustes Monta_Mensagem_Lista() p/ quando mensagem armazenada em array extrapolar o limite de caracteres
;Ultima Alteracao: 17/09/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado "NumNF" e "NumDP" em Grava_LogEx() 
;Ultima Alteracao: 17/09/2020 por Bruno Carvalho
;Motivo Alteracao: Removido IncluiRegistroControle() -> Adicionado RQCABECA,RQCABECG,MOVCONT e COMPRAS *Particularidaedes
;Ultima Alteracao: 09/10/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado COR_MENSAGEM="VERMELHO" e COR_MENSAGEM="PRETO" na proc SD_Mensagem()
;Ultima Alteracao: 22/10/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado rotina para gerar arquivo de bloqueio de tentativa de acesso ao sistema -> Arquivo_Conexao()
;Ultima Alteracao: 22/10/2020 por Bruno Carvalho
;Motivo Alteracao: Adicionado na proc Grava_LogEx() os parƒmetros "ArqBloq", "ExclArqB", "LibArq" e "Datam"  
;Ultima Alteracao: 23/10/2020 por Bruno Carvalho
;Motivo Alteracao: Movido a proc Grava_Logt() p/ Bibliot

;*******************************************************************************
;* Lista de parametros (Param(1)) para ExecVise                                *
;*******************************************************************************
;EXE -> Executa programa
;CMD -> Envia Linha de Comando
;REN -> Renomeia Arquivo
;DIR -> Monta Lista de Diretorios
;DIRF-> Monta Lista de Arquivos  Ex: Lista_DiretorioF("N:\\","*C.MB|*.DB")
;DIRD-> Monta Lista de Arquivos com Data
;             Ex: Lista_DiretorioD("N:\\","*C.MB|*.DB","S")
;                 Ordenacao: "S" Nome do arquivo; "D" Data do Arquivo
;DELT-> Deleta Pasta e SubPastas
;COP -> Copia Arquivo
;VIE -> Valida IE
;FEX -> Verifica se o arquivo existe
;*******************************************************************************

@ 22,28 ?? "Gerando Biblioteca Bibliot.Lib"
Style Blink
?? "... "

If IsFile("\\Sistemas\\Cadastro\\Bibliot.Lib")
   Then Run NoRefresh "Del \\Sistemas\\Cadastro\\Bibliot.Lib>Nul"
        Sleep 2000
EndIf
CreateLib "\\Sistemas\\Cadastro\\Bibliot" Size 230

;*******************************************************************************
;* Rotina Exibe Campo da Tabela                                                *
;*******************************************************************************
Proc Seleciona_Campo()
private i, ArraY_campossd, Array_Campos, Array_Tipos, TmList

DynArray Array_Campossd[]

TableInfo Table() Fields to Array_campos, Array_tipos

For i From 1 to NFields(Table())
  array_campossd[i]=array_campos[i]
  If Array_campossd=Field()
     Then VSDGCAMPO=i
  EndIf
EndFor

TmList=DynArraySize(array_campossd)
If TmList<=2  Then TmList=2  EndIf
If TmList>=15 Then TmList=15 EndIf

ShowDialog "Ir para o campo: " 
 @ (Int((20-(TmList+6))/2)+2),25 Height TmList+6 Width 29

  PickDynArray @1,0 Height TmList width 26
   Columns 1
    Array_campossd
     Tag "TG_CAMPOS"
      To VSDGCAMPO

 Pushbutton @ TmList+2,01 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue
 Pushbutton @ TmList+2,14 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue

EndDialog
If retval
   Then Moveto Field Array_campossd[vsdgcampo]
EndIf
Release vars vsdgcampo, i, ArraY_campossd, Array_Campos, Array_Tipos
endProc


;*******************************************************************************
;* Rotina Wait p/ Memo                                                         *
;*******************************************************************************
proc wait_Memo(triggertype,event,cyclenumber)
Private triggertype, event, cyclenumber

If triggertype="OPEN"
   Then FieldView
        
        memowindow=GetWindow()
        Window Move memowindow To -100, -100
        Window GetAttributes memowindow To WinArray_Memo
        WinArray_Memo["CANMAXIMIZE"]=True
        WinArray_Memo["CANCLOSE"]   =True
        WinArray_Memo["Title"]      ="** ANOTA€™ES **"
        WinArray_Memo["HEIGHT"]     =15
        WinArray_Memo["WIDTH"]      =76
        WinArray_Memo["ORIGINROW"]  =3
        WinArray_Memo["ORIGINCOL"]  =2
        WinArray_Memo["HASFRAME" ] = True
        WinArray_Memo["HASSHADOW"]  =True
        WinArray_Memo["CANRESIZE"]  =True
        WinArray_Memo["CANMOVE"]    =True
        WinArray_Memo["FLOATING"]   =False
        Window SetAttributes memowindow From WinArray_Memo

        Dynarray ImageColorSettings[]
        ImageColorSettings[1]=47
        ImageColorSettings[2]=46
        ImageColorSettings[3]=47
        ImageColorSettings[4]=47

        Window SetColors memowindow From ImageColorSettings
EndIf

If triggertype="ARRIVEWINDOW"
   then If getwindow()<>memowindow
           Then Window select memowindow
        EndIf
        return 0
Endif

If Triggertype="EVENT" And Event["TYPE"]="MESSAGE" and Event["MESSAGE"]="CLOSE"
   Then Return 2
EndIf

If triggertype="EVENT" And Event["TYPE"]="KEY"
   Then Switch
          Case Event["KEYCODE"]=Asc("ESC") : Return 2
          Case Event["KEYCODE"]=Asc("F2")  : Return 2
          OtherWise                        : Return 1
      EndSwitch
endif
return 0

endProc

;*******************************************************************************
;* Rotina Wait p/ ConsultaF1()                                                 *
;*******************************************************************************
proc wait_Consulta_sem_F1(triggertype,event,cyclenumber)

If Triggertype="EVENT" And Event["TYPE"]="MESSAGE" and Event["MESSAGE"]="CLOSE"
   Then wait_ok=False
        Return 2
EndIf
If triggertype="FIELDVIEW" And Event["TYPE"]="MOUSE"
   Then CopyToArray Reg_ConsultaF1
        return 2
EndIf

If triggertype="EVENT" And Event["TYPE"]="KEY"
   Then Switch
          Case event["KEYCODE"]=Asc("F1"):
               MSG=    "Teclas/Fun‡”es:                               "
               MSG=MSG+"//Esc      = Voltar                           "
               MSG=MSG+"//Enter    = Selecionar o registro            "
               MSG=MSG+"//Ctrl+R   = Rolar campos                     "
               MSG=MSG+"//F8       = Ir para o campo ?                "
               MSG=MSG+"//Alt+F5   = Abrir janela para campo Memorando"
               MSG=MSG+"//Ctrl+Z   = Localizar registro               "
               MSG=MSG+"//Alt+Z    = Localizar Pr¢ximo registro       // //"
               MSG=MSG+"Teclas/Navega‡„o:                                  "
               MSG=MSG+"//Home, End, Up, Down , Page Up, Page Down, "+Chr(27)+Chr(25)+Chr(24)+Chr(26)
               Mensagem(MSG)
               return 1
          Case event["KEYCODE"]=-31:
               return 1
          Case Event["KEYCODE"]=Asc("F8"):
               Seleciona_campo()
               return 1
          Case Event["KEYCODE"]=Asc("ZOOM"):
               PESQUISA()
               return 1
          Case Event["KEYCODE"]=Asc("ZOOMNEXT"):
               PESQUISACON()
               return 1
          Case Event["KEYCODE"]=Asc("ESC"):
               wait_ok=False
               Return 2
          Case Event["KEYCODE"]=Asc("ENTER") And ISFIELDVIEW():
               Keypress "ENTER"
               Return 1
          Case Event["KEYCODE"]=Asc("ENTER") Or Event["KEYCODE"]=Asc("F2"):
               CopyToArray Reg_ConsultaF1
               return 2
          Case Event["KEYCODE"]=Asc("FIELDVIEW") or Event["KEYCODE"]=Asc("F35"):
               If SubStr(FieldType(),1,1)<>"M" or IsBlank([])
                  Then Return 1
               EndIf

               wait Field
                 proc "wait_memo"
                 trigger "ALL"
                 Message "ALL"
                 key "ESC","F2"
               endwait
               Keypress "F2"

               Execute Comando_SpeedBar_Anterior
               return 1
          OtherWise:
              If Event["KEYCODE"]= -71  Or Event["KEYCODE"]= -79  Or  ;Home, End
                 Event["KEYCODE"]= -73  Or Event["KEYCODE"]= -81  Or  ;PgUp, PGDn
                 Event["KEYCODE"]= -72  Or Event["KEYCODE"]= -80  Or  ;Up, Down
                 Event["KEYCODE"]= -75  Or Event["KEYCODE"]= -77  Or  ;Left, Right
                 Event["KEYCODE"]= -119 Or Event["KEYCODE"]= -117 Or  ;Ctrl+Home, Ctrl+End
                 Event["KEYCODE"]= 18                                 ; Rotate Ctrl+R
                 Then
                      KeyPress Event["KEYCODE"]
                      If Field()="#"
                         Then ;;;;CtrlEnd
                              Moveto Field Campo_1
                      EndIf
                      return 1
              EndIf
      EndSwitch
endif

return 0

endProc

;*******************************************************************************
;* Rotina Wait p/ ConsultaF1()                                                 *
;*******************************************************************************
proc wait_Consulta(triggertype,event,cyclenumber)
Private triggertype, event, cyclenumber

If Triggertype="EVENT" And Event["TYPE"]="MESSAGE" and Event["MESSAGE"]="CLOSE"
   Then KeyPress "ESC"
        wait_ok=False
        Return 2
EndIf
If triggertype="FIELDVIEW" And Event["TYPE"]="MOUSE"
   Then CopyToArray Reg_ConsultaF1
        KeyPress "F2"
        return 2
EndIf

If triggertype="EVENT" And Event["TYPE"]="KEY"
   Then Switch
          Case event["KEYCODE"]=-94:
               MSG=    "      Esc= Voltar                                       //"
               MSG=MSG+"    Enter= Seleciona registro                           //"
               MSG=MSG+"   Ctrl+R= Rolar campos                                 //"
               MSG=MSG+"       F8= Ir para o campo ?                            //"
               MSG=MSG+"   Alt+F5= Abrir janela para campo Memorando            //"
               MSG=MSG+"   Ctrl+Z= Localizar registro                           //"
               MSG=MSG+"    Alt+Z= Localizar pr¢ximo registro                   //"

               MSG=MSG+"     Home= primeiro registro       Up"+Chr(25)+"= registro anterior//"
               MSG=MSG+"      End= £ltimo registro       Down"+Chr(24)+"= Pr¢ximo registro //"
               MSG=MSG+"  Page Up= P gina anterior                              //"
               MSG=MSG+"Page Down= Pr¢xima p gina                               // //"

               MSG=MSG+"* Para localizar r pido bastar teclar no campo desejado! //"
               MSG=MSG+"       BackSpace= Limpa um caracter/localiza r pido      //"
               MSG=MSG+"  Ctrl+BackSpace= Limpar/localiza r pido                 // //"
               MSG=MSG+"  Ctrl+F1= Ajuda/Teclas [?]                              "
               MsgHelp("Teclas/Fun‡”es",MSG)
               return 1
          Case event["KEYCODE"]=-31        Or
               Event["KEYCODE"]=Asc("F1"):
               return 1
          Case Event["KEYCODE"]=Asc("F8"):
               Seleciona_campo()
               return 1
          Case Event["KEYCODE"]=Asc("ZOOM"):
               PESQUISA()
               return 1
          Case Event["KEYCODE"]=Asc("ZOOMNEXT"):
               PESQUISACON()
               return 1
          Case Event["KEYCODE"]=Asc("ESC"):
               KeyPress "ESC"
               wait_ok=False
               Return 2
          Case Event["KEYCODE"]=Asc("ENTER") And ISFIELDVIEW():
               Keypress "ENTER"
               Return 1
          Case Event["KEYCODE"]=Asc("ENTER") Or Event["KEYCODE"]=Asc("F2"):
               CopyToArray Reg_ConsultaF1
               KeyPress "F2"
               return 2
          Case Event["KEYCODE"]=Asc("FIELDVIEW") or Event["KEYCODE"]=Asc("F35"):
               If SubStr(FieldType(),1,1)<>"M" or IsBlank([])
                  Then Return 1
               EndIf

               wait Field
                 proc "wait_memo"
                 trigger "ALL"
                 Message "ALL"
                 key "ALL"
               endwait
               Keypress "F2"

               return 1
          Case Event["KEYCODE"]=Asc("CTRLBACKSPACE"):
               TEXTO_LOCATE=""
               prompt TEXTO_LOCATE
               
               Return 1
          Case Event["KEYCODE"]=Asc("BACKSPACE"):
               If Field()<>FIELD_LOCATE
                  Then FIELD_LOCATE=Field()
                       TEXTO_LOCATE=""
                       prompt TEXTO_LOCATE
               Endif        

               TEXTO_LOCATE=SubStr(TEXTO_LOCATE,1,Len(TEXTO_LOCATE)-1)
               prompt TEXTO_LOCATE
               
               If Not IsBlank(TEXTO_LOCATE)
                  Then Zoom Select TEXTO_LOCATE+".."
               EndIf   
               
               Return 1
          Case (Event["KEYCODE"]>=32 And Event["KEYCODE"]<=125):
               If Field()<>FIELD_LOCATE
                  Then FIELD_LOCATE=Field()
                       TEXTO_LOCATE=""
                       prompt TEXTO_LOCATE
               Endif        

               TEXTO_LOCATE=TEXTO_LOCATE+UPPER(Chr(Event["KEYCODE"]))
               prompt TEXTO_LOCATE
               Zoom Select TEXTO_LOCATE+".."

               Return 1
          OtherWise:
              If Event["KEYCODE"]= -71  Or Event["KEYCODE"]= -79  Or  ;Home, End
                 Event["KEYCODE"]= -73  Or Event["KEYCODE"]= -81  Or  ;PgUp, PGDn
                 Event["KEYCODE"]= -72  Or Event["KEYCODE"]= -80  Or  ;Up, Down
                 Event["KEYCODE"]= -75  Or Event["KEYCODE"]= -77  Or  ;Left, Right
                 Event["KEYCODE"]= -119 Or Event["KEYCODE"]= -117 Or  ;Ctrl+Home, Ctrl+End
                 Event["KEYCODE"]= 18                                 ; Rotate Ctrl+R
                 Then
                      KeyPress Event["KEYCODE"]
                      If Field()="#"
                         Then ;;;CtrlEnd
                              Moveto Field Campo_1
                      EndIf
                      return 1
              EndIf
      EndSwitch
endif

return 0

endProc

;*******************************************************************************
;* Consulta Sem F1
;*******************************************************************************
Proc Consulta_Sem_F1()
Private Campo_1, NTabela_TableLookup, pos_ini, altura,
        WinArray, WinaArray_Memo, Janela_SF1, ImageColorSettings, vrcampo, sclookup

If IsEmpty(Table())
   Then Mensagem("Tabela de Consulta sem Registros !")
        Resultado_F1=False
        Return False
EndIf

Altura=NRecords(Table())+3
If Altura>21 Then Altura=21 EndIf

Dynarray WinArray[]
Dynarray WinArray_Memo[]


Home
CtrlHome
Right
Janela_SF1=GetWindow()
Window GetAttributes Janela_SF1 To WinArray

NTabela_TableLookup=WinArray["Title"]

WinArray["CANMAXIMIZE"]=True
WinArray["CANCLOSE"]   =True
WinArray["Title"]      ="CONSULTA/F1"
WinArray["HEIGHT"]     =Altura
WinArray["WIDTH"]      =80
WinArray["ORIGINROW"]  =1
WinArray["ORIGINCOL"]  =0
WinArray["HASSHADOW"]  =True
WinArray["CANRESIZE"]  =True
WinArray["CANMOVE"]    =True

Window SetAttributes Janela_SF1 From WinArray

Dynarray ImageColorSettings[]
ImageColorSettings[1]= 118
ImageColorSettings[2]= 127
ImageColorSettings[3]= 118
ImageColorSettings[4]= 118
Window SetColors Janela_SF1 From ImageColorSettings
SetaCorRegistro("Paginar")

Campo_1=Field()

pos_ini=1
While True
  If SearchFrom("\\",NTabela_TableLookup,pos_ini+1)>0
     Then pos_ini=SearchFrom("\\",NTabela_TableLookup,pos_ini+1)
     Else If pos_ini=1
             Then pos_ini=0
          EndIf
          QuitLoop
  EndIf
EndWhile

sclookup=true
If IsFile("\\Sistemas\\Imagens\\NoLookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)+".sc")
   Then 
        Play "\\Sistemas\\Imagens\\NoLookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)
   else     
        If IsFile("\\Sistemas\\Imagens\\Lookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)+".sc")
           Then 
                Play "\\Sistemas\\Imagens\\Lookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)
           else 
                sclookup=false
        endif        
endif
                 
if sclookup
   then
      ;;;  campo_1=Field()
        Window GetAttributes Janela_SF1 To WinArray
        WinArray["HEIGHT"]     =Altura
        WinArray["ORIGINROW"]  =1
        WinArray["ORIGINCOL"]  =0
        Window SetAttributes Janela_SF1 From WinArray
   Else 
        CtrlEnd
        Moveto Field Campo_1
EndIf

ImageRights ReadOnly

Mouse Show

FIELD_LOCATE=Field()
TEXTO_LOCATE=""

Prompt ""
SpeedBar "["+Chr(17)+"]"     :"ESC",
         "~Selecionar~"      :"ENTER",
         "~Localizar~"       :"ZOOM",
         "~Loc~|"+Chr(16)    :"ZOOMNEXT",
         "~Ir~para"          :"F8",
         "?"                 :-94,
         "|"+Chr(17)         :"HOME",
         Chr(17)             :"PGUP",
         Chr(16)             :"PGDN",
         Chr(16)+"|"         :"END"

wait_ok=True
wait workspace
  proc "wait_consulta"
  trigger "ALL"
  Message "ALL"
  Key "ALL"
endwait
ClearSpeedBar

WinArray["Title"]=NTabela_TableLookup
Window SetAttributes Janela_SF1 From WinArray
ImageRights

Return wait_ok
EndProc                                                                
                                                                                           
;*******************************************************************************
;* Consulta F1
;*******************************************************************************
Proc ConsultaF1()
Private Campo_1, NTabela_TableLookup, pos_ini, altura,
        WinArray, WinaArray_Memo, Janela_F1, ImageColorSettings, vrcampo

MSGCAMPO=""
Echo Normal
Echo Off

If Field()="Codigo Plano_Conta" And Not IsBlank([])
   Then vrcampo=[]
        Ativa_Lookup()
        If IsEmpty(Table())
           Then KeyPress "ESC"
                Mensagem("Tabela de Consulta sem Registros !")
                Return False
        EndIf
        Moveto [Codigo Plano_Conta]
        Locate vrcampo
   Else Ativa_Lookup()
        If IsEmpty(Table())
           Then KeyPress "ESC"
                Mensagem("Tabela de Consulta sem Registros !")
                Return False
        EndIf
EndIf

Altura=NRecords(Table())+3
If Altura>21 Then Altura=21 EndIf

Dynarray WinArray[]
Dynarray WinArray_Memo[]


Janela_F1=GetWindow()
Window GetAttributes Janela_F1 To WinArray

NTabela_TableLookup=WinArray["Title"]

WinArray["CANMAXIMIZE"]=True
WinArray["CANCLOSE"]   =True
WinArray["Title"]      ="CONSULTA/F1"
WinArray["HEIGHT"]     =Altura
WinArray["WIDTH"]      =80
WinArray["ORIGINROW"]  =1
WinArray["ORIGINCOL"]  =0
WinArray["HASSHADOW"]  =True
WinArray["CANRESIZE"]  =True
WinArray["CANMOVE"]    =True

Window SetAttributes Janela_F1 From WinArray

Dynarray ImageColorSettings[]
ImageColorSettings[1]= 118
ImageColorSettings[2]= 127
ImageColorSettings[3]= 118
ImageColorSettings[4]= 118
Window SetColors Janela_F1 From ImageColorSettings
SetaCorRegistro("Paginar")

Campo_1=Field()

pos_ini=1
While True
  If SearchFrom("\\",NTabela_TableLookup,pos_ini+1)>0
     Then pos_ini=SearchFrom("\\",NTabela_TableLookup,pos_ini+1)
     Else If pos_ini=1
             Then pos_ini=0
          EndIf
          QuitLoop
  EndIf
EndWhile
If IsFile("\\Sistemas\\Imagens\\Lookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)+".sc")
   Then Play "\\Sistemas\\Imagens\\Lookup\\"+SubStr(NTabela_TableLookup,pos_ini+1,8)
       ;;; campo_1=Field()
        Window GetAttributes Janela_F1 To WinArray
        WinArray["HEIGHT"]     =Altura
        WinArray["ORIGINROW"]  =1
        WinArray["ORIGINCOL"]  =0
        Window SetAttributes Janela_F1 From WinArray
   Else CtrlEnd
        Moveto Field Campo_1
EndIf

Mouse Show

FIELD_LOCATE=Field()
TEXTO_LOCATE=""

Prompt ""

SpeedBar "["+Chr(17)+"]"     :"ESC",
         "~Selecionar~"      :"ENTER",
         "~Localizar~"       :"ZOOM",
         "~Loc~|"+Chr(16)    :"ZOOMNEXT",
         "~Ir~Campo"         :"F8",
         "~?~"               :-94,
         "|"+Chr(17)         :"HOME",
         Chr(17)             :"PGUP",
         Chr(16)             :"PGDN",
         Chr(16)+"|"         :"END"

wait_ok=True
wait workspace
 proc "wait_consulta"
 trigger "ALL"
 Message "ALL"
 Key "ALL"
endwait

ClearSpeedBar

Return wait_ok
EndProc

;*******************************************************************************
;* Rotina Wait p/ Pagina()                                                     *
;*******************************************************************************
proc wait_pagina(triggertype,event,cyclenumber)
private ncampo,nrec

If triggertype="TOUCHRECORD" And Event["TYPE"]="MOUSE"
   Then If SubStr(tpform,1,2)="MR"
           Then If Not IsLockRecord()
                   Then EDITAR="S"
                        Return 2
                EndIf
        EndIf
        Return 1
EndIf

If Event["TYPE"]="KEY" And triggertype="EVENT"
   Then Switch
          Case event["KEYCODE"]=-145 And IsAssigned(MODOFILTRAR) And MODOFILTRAR:
               OrdenaCampo(Field())          
               Return 1

          Case event["KEYCODE"]=-94:

               MSG=    "      Esc= Voltar                                                //"
               MSG=MSG+" Enter/F9= Seleciona registro p/ alterar   [Lista/Ficha]         //"
               MSG=MSG+"      Del= Seleciona registro p/ excluir                         //"

               If IsAssigned(MODOFILTRAR) And MODOFILTRAR
                  Then MSG=MSG+"Ctrl+Down= Ordenar campo   [A->Z]                                //"
                  Else MSG=MSG+"                                                                 //"
               EndIf   

               MSG=MSG+"   Ctrl+Z= Localizar registro                                    //"
               MSG=MSG+"    Alt+Z= Localizar pr¢ximo registro                            // //"

               MSG=MSG+"     Home= primeiro registro     Up"+Chr(25)+"= registro anterior          //"
               MSG=MSG+"      End= £ltimo registro     Down"+Chr(24)+"= Pr¢ximo registro           //"
               MSG=MSG+"  Page Up= P gina anterior     * Ctrl+Page Up                    //"
               MSG=MSG+"Page Down= Pr¢xima p gina      * Ctrl+Page Down                  // //"
               
               MSG=MSG+"* Para localizar r pido bastar teclar no campo desejado! //"
               MSG=MSG+"       BackSpace= Limpa um caracter/localiza r pido      //"
               MSG=MSG+"  Ctrl+BackSpace= Limpar/localiza r pido                 // //"
               MSG=MSG+"  Ctrl+F1= Ajuda/Teclas [?]                                       "
               MsgHelp("Teclas/Fun‡”es",MSG)
               return 1
          Case event["KEYCODE"]=Asc("F35") Or
               event["KEYCODE"]=Asc("F1")  Or
               event["KEYCODE"]=Asc("F3")  Or
               event["KEYCODE"]=Asc("F4")  Or
               event["KEYCODE"]=Asc("F5")  Or
               event["KEYCODE"]=Asc("F6")  Or
               event["KEYCODE"]=Asc("F7")  Or
               event["KEYCODE"]=Asc("F8")  Or
               event["KEYCODE"]=Asc("F10") Or
               event["KEYCODE"]=Asc("F11") Or
               event["KEYCODE"]=Asc("F12") Or
               event["KEYCODE"]=-68        Or
               event["KEYCODE"]=-31        Or
               event["KEYCODE"]=-45        Or        
               event["KEYCODE"]=6 :        
               return 1
          Case Event["KEYCODE"]=Asc("ZOOM"):
               PESQUISA()
               prompt TEXTO_LOCATE
               return 1
          Case Event["KEYCODE"]=Asc("ZOOMNEXT"):
               PESQUISACON()
               return 1
          Case Event["KEYCODE"]=Asc("ESC"):
               Return 2
          Case Event["KEYCODE"]=Asc("DEL"):
               If Not IsLockRecord()
                  Then EXCLUIR="S"
                       Return 2
               EndIf
               Return 1
          Case Event["KEYCODE"]=Asc("F9") Or
               Event["KEYCODE"]=Asc("F2") Or
               Event["KEYCODE"]=Asc("ENTER") Or
               ISFIELDVIEW():
               If (Event["KEYCODE"]=Asc("ENTER") Or ISFIELDVIEW()) And tpform="MT"
                  Then Return 1
               EndIf
               If Not IsLockRecord()
                  Then EDITAR="S"
                  
                       If Event["KEYCODE"]=Asc("ENTER")
                          Then TECLAPAGINA="ENTER"
                       Endif  
                  
                       Return 2
               EndIf
               Return 1
          Case Event["KEYCODE"]=Asc("DOWN"):
               If SubStr(tpform,1,2)="MR"
                  Then If Not AtLast()
                          Then nrec=recno() 
                               ncampo=Field()
                               Down
                               while true
                                 If recno()=nrec
                                    Then nrec=recno()
                                         Down
                                    else quitloop
                                 EndIf   
                               endwhile
                               moveto field ncampo
                               Return 1
                          Else If tpform="MR"
                                  Then Return 2
                                  Else Return 1
                               EndIf
                       EndIf
                  Else Right
               EndIf
               Return 1
          Case Event["KEYCODE"]=Asc("PGUP") Or
               Event["KEYCODE"]=Asc("PGDN"):
               If npages()=1
                  Then ncampo=Field()
                       KeyPress Event["KEYCODE"]
                       moveto field ncampo
                  Else KeyPress Event["KEYCODE"]
               EndIf        
               return 1
          Case Event["KEYCODE"]=Asc("UP"):
               If SubStr(tpform,1,2)="MR"
                  Then nrec=recno() 
                       ncampo=Field()
                       Up
                       while true
                         If recno()=nrec and recno()<>1
                            Then Up
                                 nrec=recno()
                            else quitloop
                         EndIf   
                       endwhile
                       moveto field ncampo
                  Else Left
               EndIf
               Return 1

          Case Event["KEYCODE"]=Asc("CTRLBACKSPACE"):
               TEXTO_LOCATE=""
               prompt TEXTO_LOCATE
               
               Return 1
          Case Event["KEYCODE"]=Asc("BACKSPACE"):
               If Field()<>FIELD_LOCATE
                  Then FIELD_LOCATE=Field()
                       TEXTO_LOCATE=""
                       prompt TEXTO_LOCATE
               Endif        

               TEXTO_LOCATE=SubStr(TEXTO_LOCATE,1,Len(TEXTO_LOCATE)-1)
               prompt TEXTO_LOCATE
               
               If Not IsBlank(TEXTO_LOCATE)
                  Then Zoom Select TEXTO_LOCATE+".."
               EndIf   
               
               Return 1
          Case (Event["KEYCODE"]>=32 And Event["KEYCODE"]<=125):
               If Field()<>FIELD_LOCATE
                  Then FIELD_LOCATE=Field()
                       TEXTO_LOCATE=""
                       prompt TEXTO_LOCATE
               Endif        

               TEXTO_LOCATE=TEXTO_LOCATE+UPPER(Chr(Event["KEYCODE"]))
               prompt TEXTO_LOCATE
               Zoom Select TEXTO_LOCATE+".."

               Return 1
          OtherWise:
              KeyPress Event["KEYCODE"]
              return 1
      EndSwitch
endif

return 0

endProc


;*******************************************************************************
;*  ROTINA PARA PAGINACAO DE TABELA EM FORM                                    *
;*******************************************************************************
Proc Pagina(TabIda,Tipo)
Private TABIDA,TIPO

SEMREGISTRO=False
TECLAPAGINA=""

Mouse Show
If RecordStatus("New")=True
   Then Del
EndIf

tpform =TIPO
EDITAR ="N"
EXCLUIR="N"
If RecordStatus("New")
   Then If SubStr(TIPO,1,2)="MT"
           Then MENSAGEM("Tabela sem Registros !")
        EndIf   
        Return
EndIf

Moveto TABIDA
If SubStr(TIPO,1,2)="MR"
   Then Switch
          Case RetVal="F7" or RetVal="HOME":
               Home
          Case RetVal="PGUP":
               PgUp
        EndSwitch
   Else Switch
          Case RetVal="F7" or RetVal="HOME":
               Home
        EndSwitch
EndIf
TABIDA=Table()

If Not IsAssigned(UltimaTabela_Pagina) Then UltimaTabela_Pagina="" EndIf
If Not IsAssigned(UltimoCampo_Pagina)  Then UltimaCampo_Pagina=""  EndIf

If UltimaTabela_Pagina=TABIDA 
   Then Moveto Field UltimoCampo_Pagina
   Else TEXTO_LOCATE=""
EndIf

FIELD_LOCATE=Field()

ImageRights ReadOnly
SetaCorRegistro("Paginar")

msgcampo =""
prompt TEXTO_LOCATE

Switch
  Case IsAssigned(MODOFILTRAR) And MODOFILTRAR:

    SpeedBar "["+Chr(17)+"]"     :"ESC",
             "~Alterar~"         :"F9",
             "~Excluir~"         :"DEL",
             "~A->Z~"            :-145,
             "~Localizar~"       :"ZOOM",
             "~Loc~|"+Chr(16)    :"ZOOMNEXT",
             "~?~"               :-94,
             "|"+Chr(17)         :"HOME",
             Chr(17)             :"PGUP",
             Chr(16)             :"PGDN",
             Chr(16)+"|"         :"END"

  OtherWise:

    SpeedBar "["+Chr(17)+"]"     :"ESC",
             "~Alterar~"         :"F9",
             "~Excluir~"         :"DEL",
             "~Localizar~"       :"ZOOM",
             "~Loc~|"+Chr(16)    :"ZOOMNEXT",
             "~?~"               :-94,
             "|"+Chr(17)         :"HOME",
             Chr(17)             :"PGUP",
             Chr(16)             :"PGDN",
             Chr(16)+"|"         :"END"
    
EndSwitch

wait workspace
  proc "wait_pagina"
  trigger "ALL"
  Message "ALL"
  Key "ALL"
endwait
  
ClearSpeedBar

If Table()<>TABIDA
   Then Moveto TABIDA
EndIf   
If EDITAR="S" Or EXCLUIR="S"
   Then UltimaTabela_Pagina=TABIDA 
        UltimoCampo_Pagina =Field()
        PegaPosForm()
   Else UltimaTabela_Pagina=""
        UltimoCampo_Pagina =""
EndIf
SetaCorRegistro("Editar")
ImageRights

EndProc

;*******************************************************************************
;* Rotina Monta SpeedBar                                                       *
;*******************************************************************************
Proc prompt_Speedbar(s)
private s,tecla,texto,comando,p,ps,i,sok

ClearSpeedBar

sok=True
comando=""
If IsAssigned(s_anterior)
   Then if s=s_anterior
           Then sok=False
                comando=comando_speedbar_anterior
        endif
Endif
s_anterior=s
While sok
  p=searchFrom("=",s,1)

  If p=0 And Len(S)=0
     Then QuitLoop
     Else

          tecla=""
          texto=""
          tecla=Strim(SubStr(s,1,(p-1)))

          ps=0
          for i from 1 to 15
            Switch
              Case SubStr(s,p+i,1)=" ": ps=p+i
              Case SubStr(s,p+i,1)="=": QuitLoop
            EndSwitch
          endFor

          if ps>0
             then texto=Ltrim(Rtrim( SubStr(s,(p+1),ps-(p+1)) ))
                  s=Rtrim(LTrim(SubStr(s,(ps+1),80)))
             Else texto=Ltrim(Rtrim( SubStr(s,(p+1),(Len(s)-p)) ))
                  s=""
          endif
          if IsBlank(Comando)
             Then Comando="SpeedBar "
             Else Comando=Comando+","
          endif
          If IsBlank(Tecla) And Not IsBlank(Texto)
             Then tecla=texto
                  texto=""
          endif
          comando=comando+"\"~"+Tecla+"~"+texto+"\":"

          tecla=Upper(tecla)
          Switch
            Case Tecla="CTRL+R": tecla="ROTATE"
            Case Tecla="CTRL+Z": tecla="ZOOM"
            Case Tecla="ALT+Z" : tecla="ZOOMNEXT"
            Case Tecla="ALT+F" : tecla="-33"
          EndSwitch
          if SubStr(tecla,1,1)="-"
             Then Comando=Comando+Tecla
             Else Comando=Comando+"\""+tecla+"\""
          endif

  Endif

EndWhile

if IsBlank(comando)
   Then prompt s
   Else Execute Comando
        prompt ""
        comando_speedbar_anterior=comando
endif

endproc

;*******************************************************************************
;* Checagem do FieldView                                                       *
;*******************************************************************************
Proc Closed EditField()
UseVars AutoLib, ErrorProc
Private vrant

vrant=[]

FieldView
Prompt "  * Editando conte£do *    [Enter]Confirmar  [Esc]Desfazer"
Wait Field
     Until "Enter","ESC"
     
If RetVal="ESC"
   Then []=vrant
EndIf
EndProc


;*******************************************************************************
;* Rotina para bloquear registro                                               *
;*******************************************************************************
Proc IsLockRecord()
Private cont,msgerro,Infoerro

Cont=0
While True
  LockRecord
  If RetVal
     Then Return False
     Else If Cont<3
             Then Cont=Cont+1
                  Sleep 3000
                  Loop
          EndIf
          ErrorInfo To Infoerro
          msgerro = Completa("     Run: "+StrVal(Infoerro["LINE"])+"_"+StrVal(Infoerro["POSITION"])+"_"+Infoerro["SCRIPT"],60," ")+"//"+
                    Completa("    User: "+Infoerro["USER"],60," ")+"//"+
                    Completa("    Proc: "+Infoerro["PROC"],60," ")+"//"+
                    Completa("   Table: ["+Upper(Table())+"]",60," ")+"//"+
                    Completa("   Field: ["+Upper(Field())+"]",60," ")+"////" 
                    
          msgerro = msgerro + Spaces(2)+"Registro em uso pelo usu rio "+Upper(ErrorUser())+"."
          MENSAGEM(msgerro)
          Return True
  EndIf
EndWhile

EndProc

;*******************************************************************************
;* Rotina para bloquear registro em Loop                                       *
;*******************************************************************************
Proc Closed IsLockRecordL()
UseVars AutoLib, ErrorProc
Private cont

Cont=0
While True
  LockRecord
  If RetVal
     Then Return False
     Else If Cont<3
             Then Cont=Cont+1
                  Sleep 3000
                  Loop
          EndIf
          Return True
  EndIf
EndWhile

EndProc

;****************************************************
;** ROTINA PARA PESQUISA DE CAMPOS                 **
;****************************************************
Proc Closed Pesquisa()
UseVars AutoLib, ErrorProc, PES_CAMPO, TEXTO_LOCATE, FIELD_LOCATE
Private TITULO_SD, NREG, wc, c, ncampo

If Field()="#"
   Then FastMsg("Campo Invalido !")
        Return
EndIf
ncampo=Field()
Switch
  Case Search("CGC",ncampo)>0           : ncampo="CNPJ/CPF"
  Case Search("Nome fantasia",ncampo)>0 : ncampo="Nome Fantasia"
EndSwitch

TITULO_SD="Localizar texto"

While True

 ShowDialog TITULO_SD @07,12 height 12 width 60

  @ 01,06 ?? "Campo:"
  @ 01,14 ?? ncampo 
  PaintCanvas Attribute 14 01,13,01,48
  
  Label @ 02,05 "Texto:" For "CAMPO"
  Accept @ 02,13 width 36 "A40" Picture "!*!" tag "CAMPO" to PES_CAMPO

  @ 04,06 ?? "Exemplos: 1) Texto..   = Iniciando"
  @ 05,06 ?? "          2) ..Texto   = Finalizando"
  @ 06,06 ?? "          3) ..Texto.. = Em Qualquer Parte"

  Pushbutton @ 08,14 width 11 "~O~k"      OK     Default Value "Ok" Tag "OK"     To BottonValue
  Pushbutton @ 08,32 width 11 "~C~ancela" CANCEL                    Tag "CANCEL" To BottonValue

 Enddialog
 If RetVal
    Then 
         If Search("..",PES_CAMPO)=0 Then
             Switch
               Case FieldType()="D":
                 Switch
                   Case Len(PES_CAMPO)<=1                      : c=0
                   Case SubStr(PES_CAMPO,1,1)="."              : c=0
                   Case SubStr(PES_CAMPO,Len(PES_CAMPO),1)="." : c=0
                   OtherWise:
                     c=0
                     wc=SearchFrom(".",PES_CAMPO,1)
                     If wc>1
                        Then c=c+1
                             wc=SearchFrom(".",PES_CAMPO,wc+1)
                             If wc>1
                                Then c=c+1
                                     wc=SearchFrom(".",PES_CAMPO,wc+1)
                                     If wc>1
                                        Then c=c+1
                                     EndIf
                             EndIf
                     EndIf
                 EndSwitch
                 If c<2 or c>2
                    Then FastMsg("Texto incorreto em campo 'Data' !")
                         Loop
                 EndIf
               Case FieldType()="S":
                 If Not E_Numerico(PES_CAMPO) Or Search(".",PES_CAMPO)>0
                    Then FastMsg("Texto incorreto em campo 'Numero inteiro' !")
                         Loop
                 EndIf
               Case FieldType()="N":
                 If Not E_Numerico(PES_CAMPO)
                    Then FastMsg("Texto incorreto em campo 'Decimal' !")
                         Loop
                 EndIf
               Case FieldType()="$":
                 If Not E_Numerico(PES_CAMPO)
                    Then FastMsg("Texto incorreto em campo 'Monet rio' !")
                         Loop
                 EndIf
             EndSwitch
         EndIf

         Message("Procurando...")
         NREG=RecNo()
         Zoom Select PES_CAMPO
         
         Message("")
         If RecNo()=NREG
            Then FastMsg("Texto n„o localizado !")
         EndIf
         FileWrite Privdir()+"pes_camp.sc" From "PES_CAMPO=\"" +PES_CAMPO +"\""
         
         TEXTO_LOCATE=""
         FIELD_LOCATE=Field()
 EndIf
 Style Attribute 31
 QuitLoop
EndWhile
EndProc

;****************************************************
;** ROTINA PARA CONTINUACAO DE PESQUISA DE CAMPOS  **
;****************************************************
Proc Closed PesquisaCon()
UseVars AutoLib, ErrorProc, PES_CAMPO, TEXTO_LOCATE
Private MSG, NREG, textok

textok=false
If IsAssigned(TEXTO_LOCATE)
   Then If IsBlank(TEXTO_LOCATE)
           Then If IsAssigned(PES_CAMPO) And
                   Not IsBlank(PES_CAMPO)
                   Then textok=True
                EndIf   
           Else textok=true        
        Endif
   Else If IsAssigned(PES_CAMPO) And
           Not IsBlank(PES_CAMPO) 
           Then textok=True
        EndIf   
Endif
If not textok
   Then FastMsg("Texto n„o informado !")
        Return
EndIf        

Message("Procurando...")
NREG=RecNo()
ZoomNext
Message("")
If RecNo()=NREG
  Then FastMsg("Fim da Pesquisa !")
EndIf
EndProc

;*******************************************************************************
;* Rotina Mensagem Rapida e curta                                              *
;*******************************************************************************
Proc oldFastMsg(S)

Message Format("W70,AC",s)
Sound 700 5
Sleep 1000
Message ""

Endproc

;******************************************
;* Rotina p/ confirmacao Sim/Nao - Janela *
;******************************************
Proc Confirma()
Return ConfGeral("Confirma a opera‡„o ?")
EndProc

;********************************************
;* Rotina p/ confirmar Exclusao de registro *
;********************************************
Proc QuerExcluir(s)
private s
if isBlank(s)
   Then Return ConfGeral("Confirma a exclus„o deste registro ?")
   Else Return ConfGeral("Confirma a exclus„o "+s+" ?")
EndIf
EndProc

;********************************************
;* Rotina p/ confirmar Exclusao de registro *
;********************************************
Proc QuerDesfazer(s)
private s

;-- Desfazer ‚ for‡ado, independente se registro foi alterado ou nÆo !

;;If RecordStatus("Modified")=True Or s="F"
;;   Then 

        COR_MENSAGEM="1"
        if isBlank(s) Or s="F"
           Then Return ConfGeral("Confirma desfazer a altera‡ao para este registro ?")
           Else Return ConfGeral("Confirma desfazer "+s+" ?")
        EndIf
        Release Vars COR_MENSAGEM

;;   Else Return True
;;EndIf
EndProc

;******************************************
;* Rotina p/ confirmacao Sim/Nao - Janela *
;******************************************
Proc Confirma_Supervisor()
OK=""
If Not Checa_Supervisor()
   Then Return False
EndIf
Return Confirma()
EndProc

;******************************************
;* Rotina p/ confirmacao Sim/Nao - Janela *
;******************************************
Proc ConfGeral_Supervisor(MSG)
Private MSG
OK=""
If Not Checa_Supervisor()
   Then Return False
EndIf
Return ConfGeral(MSG)
EndProc

;*********************************************************************
;* Rotina p/ confirmacao Sim/Nao - Janela c/ Mensagem c/ Foco no NAO *
;*********************************************************************
Proc ConfGeral_N2(MSG)
Private x

ConfGeralNao    = "N"

x=ConfGeral(MSG)
Release Vars ConfGeralNao

Return x
EndProc ;ConfGeral_N()

;******************************************************
;* Rotina p/ confirmacao Sim/Nao - Janela c/ Mensagem *
;******************************************************
Proc ConfGeral2(MSG)
Private MSG

If Not IsAssigned(ConfGeralNao) Then ConfGeralNao="S" EndIf  

If ConfGeralNao="N"
   Then titmsg="ALERTA !"
   Else titmsg="ATEN€ŽO !"
EndIf               
            
tpmsg="Confgeral"
Monta_Mensagem(MSG)
TpSD_ConfGeral="Sim/Nao"
Mouse Show
Sound 700 5
Showdialog titmsg Proc "SD_ConfGeral"
   Trigger "OPEN","ARRIVE"
    Key "ENTER","LEFT","RIGHT","S","s","N","n"
     @ Int((25-(NLinhas+6))/2),CIM Height NLinhas+6 width LJM

   @ NumVal(SubStr(Linha_MSg[01],1,2)),Int((LJM-Len(Linha_Msg[01]))/2) ?? SubStr(Linha_Msg[01],3,LJM)
   @ NumVal(SubStr(Linha_MSg[02],1,2)),Int((LJM-Len(Linha_Msg[02]))/2) ?? SubStr(Linha_Msg[02],3,LJM)
   @ NumVal(SubStr(Linha_MSg[03],1,2)),Int((LJM-Len(Linha_Msg[03]))/2) ?? SubStr(Linha_Msg[03],3,LJM)
   @ NumVal(SubStr(Linha_MSg[04],1,2)),Int((LJM-Len(Linha_Msg[04]))/2) ?? SubStr(Linha_Msg[04],3,LJM)
   @ NumVal(SubStr(Linha_MSg[05],1,2)),Int((LJM-Len(Linha_Msg[05]))/2) ?? SubStr(Linha_Msg[05],3,LJM)
   @ NumVal(SubStr(Linha_MSg[06],1,2)),Int((LJM-Len(Linha_Msg[06]))/2) ?? SubStr(Linha_Msg[06],3,LJM)
   @ NumVal(SubStr(Linha_MSg[07],1,2)),Int((LJM-Len(Linha_Msg[07]))/2) ?? SubStr(Linha_Msg[07],3,LJM)
   @ NumVal(SubStr(Linha_MSg[08],1,2)),Int((LJM-Len(Linha_Msg[08]))/2) ?? SubStr(Linha_Msg[08],3,LJM)
   @ NumVal(SubStr(Linha_MSg[09],1,2)),Int((LJM-Len(Linha_Msg[09]))/2) ?? SubStr(Linha_Msg[09],3,LJM)
   @ NumVal(SubStr(Linha_MSg[10],1,2)),Int((LJM-Len(Linha_Msg[10]))/2) ?? SubStr(Linha_Msg[10],3,LJM)
   @ NumVal(SubStr(Linha_MSg[11],1,2)),Int((LJM-Len(Linha_Msg[11]))/2) ?? SubStr(Linha_Msg[11],3,LJM)
   @ NumVal(SubStr(Linha_MSg[12],1,2)),Int((LJM-Len(Linha_Msg[12]))/2) ?? SubStr(Linha_Msg[12],3,LJM)
   @ NumVal(SubStr(Linha_MSg[13],1,2)),Int((LJM-Len(Linha_Msg[13]))/2) ?? SubStr(Linha_Msg[13],3,LJM)
   @ NumVal(SubStr(Linha_MSg[14],1,2)),Int((LJM-Len(Linha_Msg[14]))/2) ?? SubStr(Linha_Msg[14],3,LJM)
   @ NumVal(SubStr(Linha_MSg[15],1,2)),Int((LJM-Len(Linha_Msg[15]))/2) ?? SubStr(Linha_Msg[15],3,LJM)

   PushButton @ NLinhas+2,Int((LJM-26)/2)    width 11 "~S~im"     OK  Default Value "Sim" Tag "YES" To BottonValue
   PushButton @ NLinhas+2,Int((LJM-26)/2)+13 width 11 "~N~„o" CANCEL                      Tag "NO"  To BottonValue

Enddialog
If RetVal
   Then OK="S"
   Else OK="N"
EndIf
LimpaRodape(0)

Release Vars MSG, NLinhas, Linha_Msg, LJM, CIM, COR_MENSAGEM
Style Attribute 31

If OK="S"
   Then Return True
   Else Return False
EndIf

EndProc

;*******************************************************************************
;* Rotina Monta Janela de Mensagem                                             *
;*******************************************************************************
Proc Mensagem2(MSG)
Private MSG,titmsg

If Not IsAssigned(ConfGeralNao) Then ConfGeralNao="S" EndIf  

tpmsg="Mensagem"
Monta_Mensagem(MSG)
Mouse Show
Sound 700 5
If IsAssigned(COR_MENSAGEM)
   Then titmsg="LEMBRETE !"
   Else titmsg="ATEN€ŽO !"
EndIf

Showdialog titmsg Proc "SD_ConfGeral"
   Trigger "OPEN","ARRIVE"
    Key "ALL"
     @ Int((25-(NLinhas+6))/2),CIM Height NLinhas+6 width LJM

   @ NumVal(SubStr(Linha_MSg[01],1,2)),Int((LJM-Len(Linha_Msg[01]))/2) ?? SubStr(Linha_Msg[01],3,LJM)
   @ NumVal(SubStr(Linha_MSg[02],1,2)),Int((LJM-Len(Linha_Msg[02]))/2) ?? SubStr(Linha_Msg[02],3,LJM)
   @ NumVal(SubStr(Linha_MSg[03],1,2)),Int((LJM-Len(Linha_Msg[03]))/2) ?? SubStr(Linha_Msg[03],3,LJM)
   @ NumVal(SubStr(Linha_MSg[04],1,2)),Int((LJM-Len(Linha_Msg[04]))/2) ?? SubStr(Linha_Msg[04],3,LJM)
   @ NumVal(SubStr(Linha_MSg[05],1,2)),Int((LJM-Len(Linha_Msg[05]))/2) ?? SubStr(Linha_Msg[05],3,LJM)
   @ NumVal(SubStr(Linha_MSg[06],1,2)),Int((LJM-Len(Linha_Msg[06]))/2) ?? SubStr(Linha_Msg[06],3,LJM)
   @ NumVal(SubStr(Linha_MSg[07],1,2)),Int((LJM-Len(Linha_Msg[07]))/2) ?? SubStr(Linha_Msg[07],3,LJM)
   @ NumVal(SubStr(Linha_MSg[08],1,2)),Int((LJM-Len(Linha_Msg[08]))/2) ?? SubStr(Linha_Msg[08],3,LJM)
   @ NumVal(SubStr(Linha_MSg[09],1,2)),Int((LJM-Len(Linha_Msg[09]))/2) ?? SubStr(Linha_Msg[09],3,LJM)
   @ NumVal(SubStr(Linha_MSg[10],1,2)),Int((LJM-Len(Linha_Msg[10]))/2) ?? SubStr(Linha_Msg[10],3,LJM)
   @ NumVal(SubStr(Linha_MSg[11],1,2)),Int((LJM-Len(Linha_Msg[11]))/2) ?? SubStr(Linha_Msg[11],3,LJM)
   @ NumVal(SubStr(Linha_MSg[12],1,2)),Int((LJM-Len(Linha_Msg[12]))/2) ?? SubStr(Linha_Msg[12],3,LJM)
   @ NumVal(SubStr(Linha_MSg[13],1,2)),Int((LJM-Len(Linha_Msg[13]))/2) ?? SubStr(Linha_Msg[13],3,LJM)
   @ NumVal(SubStr(Linha_MSg[14],1,2)),Int((LJM-Len(Linha_Msg[14]))/2) ?? SubStr(Linha_Msg[14],3,LJM)
   @ NumVal(SubStr(Linha_MSg[15],1,2)),Int((LJM-Len(Linha_Msg[15]))/2) ?? SubStr(Linha_Msg[15],3,LJM)

   PushButton @ NLinhas+2,Int((LJM-11)/2)    width 11 "~O~k"    OK       Default Value "Ok" Tag "MENS_OK"  To BottonValue

Enddialog
LimpaRodape(0)

Release Vars MSG, NLinhas, Linha_Msg, LJM, CIM, COR_MENSAGEM
Style Attribute 31
EndProc

;*******************************************************************************
;* Rotina Monta Janela de Mensagem/Help                                        *
;*******************************************************************************
Proc MsgHelp(Titmsg,MSG)
Private MSG,titmsg

If Not IsAssigned(ConfGeralNao) Then ConfGeralNao="S" EndIf  

tpmsg="MsgHelp"
Monta_Mensagem(MSG)
Mouse Show
Sound 700 5
Showdialog titmsg Proc "SD_ConfGeral"
   Trigger "OPEN","ARRIVE"
    Key "ALL"
     @ Int((25-(NLinhas+5))/2),CIM Height NLinhas+4 Width LJM

   @ NumVal(SubStr(Linha_MSg[01],1,2)),Int((LJM-Len(Linha_Msg[01]))/2) ?? SubStr(Linha_Msg[01],3,LJM)
   @ NumVal(SubStr(Linha_MSg[02],1,2)),Int((LJM-Len(Linha_Msg[02]))/2) ?? SubStr(Linha_Msg[02],3,LJM)
   @ NumVal(SubStr(Linha_MSg[03],1,2)),Int((LJM-Len(Linha_Msg[03]))/2) ?? SubStr(Linha_Msg[03],3,LJM)
   @ NumVal(SubStr(Linha_MSg[04],1,2)),Int((LJM-Len(Linha_Msg[04]))/2) ?? SubStr(Linha_Msg[04],3,LJM)
   @ NumVal(SubStr(Linha_MSg[05],1,2)),Int((LJM-Len(Linha_Msg[05]))/2) ?? SubStr(Linha_Msg[05],3,LJM)
   @ NumVal(SubStr(Linha_MSg[06],1,2)),Int((LJM-Len(Linha_Msg[06]))/2) ?? SubStr(Linha_Msg[06],3,LJM)
   @ NumVal(SubStr(Linha_MSg[07],1,2)),Int((LJM-Len(Linha_Msg[07]))/2) ?? SubStr(Linha_Msg[07],3,LJM)
   @ NumVal(SubStr(Linha_MSg[08],1,2)),Int((LJM-Len(Linha_Msg[08]))/2) ?? SubStr(Linha_Msg[08],3,LJM)
   @ NumVal(SubStr(Linha_MSg[09],1,2)),Int((LJM-Len(Linha_Msg[09]))/2) ?? SubStr(Linha_Msg[09],3,LJM)
   @ NumVal(SubStr(Linha_MSg[10],1,2)),Int((LJM-Len(Linha_Msg[10]))/2) ?? SubStr(Linha_Msg[10],3,LJM)
   @ NumVal(SubStr(Linha_MSg[11],1,2)),Int((LJM-Len(Linha_Msg[11]))/2) ?? SubStr(Linha_Msg[11],3,LJM)
   @ NumVal(SubStr(Linha_MSg[12],1,2)),Int((LJM-Len(Linha_Msg[12]))/2) ?? SubStr(Linha_Msg[12],3,LJM)
   @ NumVal(SubStr(Linha_MSg[13],1,2)),Int((LJM-Len(Linha_Msg[13]))/2) ?? SubStr(Linha_Msg[13],3,LJM)
   @ NumVal(SubStr(Linha_MSg[14],1,2)),Int((LJM-Len(Linha_Msg[14]))/2) ?? SubStr(Linha_Msg[14],3,LJM)
   @ NumVal(SubStr(Linha_MSg[15],1,2)),Int((LJM-Len(Linha_Msg[15]))/2) ?? SubStr(Linha_Msg[15],3,LJM)
   @ NumVal(SubStr(Linha_MSg[16],1,2)),Int((LJM-Len(Linha_Msg[16]))/2) ?? SubStr(Linha_Msg[16],3,LJM)
   @ NumVal(SubStr(Linha_MSg[17],1,2)),Int((LJM-Len(Linha_Msg[17]))/2) ?? SubStr(Linha_Msg[17],3,LJM)

   PushButton @ 00,85 width 11 "~O~k"    OK       Default Value "Ok" Tag "MENS_OK"  To BottonValue
   
Enddialog
LimpaRodape(0)

Release Vars MSG, NLinhas, Linha_Msg, LJM, CIM
Style Attribute 31
EndProc
                                           
;******************************************************
;* Rotina p/ Montagem Mensagem ou ConfGeral           *
;******************************************************
Proc Monta_Mensagem(MSG)
Private MSG, posinicial, posicaoc, MaiorLinha, nl, i

Switch
  Case tpmsg="MsgHelp"  : nl=17
  Case tpmsg="Mensagem" : nl=17
  OtherWise             : nl=15
EndSwitch

Array Linha_Msg[nl]
NLinhas=1
posinicial=1
For i From 1 To nl
  posicaoc=SearchFrom("//",MSG,posinicial)
  If posicaoc>0
     Then Linha_Msg[NLinhas]=AlinhM(StrVal(NLinhas),2)+SubStr(MSG,posinicial,posicaoc-posinicial)
          NLinhas=NLinhas+1
          posinicial=posicaoc+2
     Else Linha_Msg[NLinhas]=AlinhM(StrVal(NLinhas),2)+SubStr(MSG,posinicial,Len(MSG))
          For i2 From NLinhas+1 To nl
            Linha_Msg[i2]=AlinhM(StrVal(NLinhas+1),2)+""
          EndFor
          QuitLoop
  EndIf
EndFor

If NLinhas>nl
   Then NLinhas=nl
EndIf   

MSG=Linha_MSG[1]
MaiorLinha=1
For i From 1 To nl
  If Len(Linha_Msg[i])>Len(MSG)
     Then MaiorLinha=i
          MSG=Linha_MSG[i]
  EndIf
EndFor

LJM=Len(Linha_Msg[MaiorLinha])+2
If LJM>78
   Then LJM=74
   Else If LJM < 30
           Then LJM=30
        EndIf
EndIf
CIM=INT((80-LJM)/2)+1

Release Vars posinicial,posicaoc,MaiorLinha,MSG, nl
Endproc

;******************************************************
;* Rotina p/ Mensagem                                 *
;******************************************************
Proc Mensagem(MSG)

;A Procedure antiga de mensagem, assim como as demais caixas de mensagem, estÆo com o
;n£mero 2 na frente, mantendo a partir de 10.12.2014 a nova implementa‡Æo das mensagens
;em apenas um controle "SD_Mensagem".

ConfGeralNao = ""
Mensagem_Padrao(MSG)

EndProc ;Mensagem()

;*********************************************************************
;* Rotina p/ confirmacao Sim/Nao - Janela c/ Mensagem c/ Foco no NAO *
;*********************************************************************
Proc ConfGeral_N(MSG)
Private Aux_MSG

ConfGeralNao = "N"
Aux_MSG = Mensagem_Padrao(MSG)

If Aux_MSG
   Then OK = "S" 
   Else OK = "N"
EndIf

Return Aux_MSG

EndProc ;ConfGeral_N()

;******************************************************
;* Rotina p/ confirmacao Sim/Nao - Janela c/ Mensagem *
;******************************************************
Proc ConfGeral(MSG)
Private Aux_MSG

ConfGeralNao = "S"
Aux_MSG = Mensagem_Padrao(MSG)

If Aux_MSG
   Then OK = "S" 
   Else OK = "N"
EndIf

Return Aux_MSG
                                              
EndProc ;ConfGeral()
            
;*******************************************************************************
;* ROTINA CONFGERAL DIALOG                                                     *
;*******************************************************************************
Proc SD_Mensagem(Disparo_SDCF,Campo_SDCF,Evento_SDCF,Elemento_SDCF)
Private Disparo_SDCF,Campo_SDCF,Evento_SDCF,Elemento_SDCF,Temp,CoresSD_ConfGeral,TECLA, MSG_CAMPO

Temp=True
MSG_CAMPO=""
TECLA=""
If Disparo_SDCF="OPEN"
   Then 
        Window handle Dialog To Janela_SD_ConfGeral
        If IsAssigned(CoresSD_ConfGeral)
           Then Release Vars CoresSD_ConfGeral
        EndIf
        Dynarray WinArray8[]
        Dynarray CoresSD_ConfGeral[]
        
        Switch
          Case IsAssigned(COR_MENSAGEM) : 
               Switch
                 Case COR_MENSAGEM="ALERTA" : 
                      CoresSD_ConfGeral[01]=249                               ;Borda e T¡tulo          Branco_Azul
                      CoresSD_ConfGeral[05]=240                               ;Frame/Textos            Branco_Preto
                      CoresSD_ConfGeral[09]=27                                ;Button Sem Sele‡Æo      Azul_Branco
                      CoresSD_ConfGeral[11]=26                                ;Button Selecionado      Azul_VerdeDest
                      CoresSD_ConfGeral[13]=26                                ;HotKey Button           Azul_VerdeDest                                                         
                      CoresSD_ConfGeral[14]=240                               ;Sombra Button           Branco_Preto
                      If DISPLAY_ALT > 9
                         Then CoresSD_ConfGeral[25]=249
                              CoresSD_ConfGeral[27]=249
                              CoresSD_ConfGeral[26]=249
                              CoresSD_ConfGeral[04]=245
                         Else CoresSD_ConfGeral[25]=249
                              CoresSD_ConfGeral[27]=249
                              CoresSD_ConfGeral[26]=249
                              CoresSD_ConfGeral[04]=245
                      EndIf
                 Case COR_MENSAGEM="MEMO" :
                      CoresSD_ConfGeral[01]=96
                      CoresSD_ConfGeral[02]=111
                      CoresSD_ConfGeral[03]=96 
                      CoresSD_ConfGeral[04]=96   ;Barra de Rolagem
                      CoresSD_ConfGeral[18]=96
                      CoresSD_ConfGeral[19]=96 
                      CoresSD_ConfGeral[20]=96
                      CoresSD_ConfGeral[05]=112
                      CoresSD_ConfGeral[25]=112  ;Cor do Fundo da Lista
                      CoresSD_ConfGeral[27]=112  ;Cor da Barra Selecionada
                      CoresSD_ConfGeral[26]=112  ;Cor da Barra Selecionada

                 Case COR_MENSAGEM="PRETO" : 
                      CoresSD_ConfGeral[01]=15                               ;Borda e T¡tulo 
                      CoresSD_ConfGeral[05]=15                              ;Frame/Textos   
                      CoresSD_ConfGeral[09]=27                              ;Button Sem Sele‡Æo
                      CoresSD_ConfGeral[11]=249                             ;Button Selecionado
                      CoresSD_ConfGeral[13]=249                             ;HotKey Button                                                              
                      CoresSD_ConfGeral[14]=7                               ;Sombra Button     
                      If DISPLAY_ALT > 9
                         Then CoresSD_ConfGeral[25]=7
                              CoresSD_ConfGeral[27]=7
                              CoresSD_ConfGeral[26]=7
                              CoresSD_ConfGeral[04]=6
                         Else CoresSD_ConfGeral[25]=7
                              CoresSD_ConfGeral[27]=7
                              CoresSD_ConfGeral[26]=7
                              CoresSD_ConfGeral[04]=6
                      EndIf
                      
                 Case COR_MENSAGEM="VERMELHO" :    
                      CoresSD_ConfGeral[01]=199                            
                      CoresSD_ConfGeral[05]=207                            
                      CoresSD_ConfGeral[09]=116                            
                      CoresSD_ConfGeral[11]=116                            
                      CoresSD_ConfGeral[13]=116                                                                                     
                      CoresSD_ConfGeral[14]=207                            
                      If DISPLAY_ALT > 9
                         Then CoresSD_ConfGeral[25]=203
                              CoresSD_ConfGeral[27]=203
                              CoresSD_ConfGeral[26]=203
                              CoresSD_ConfGeral[04]=202
                         Else CoresSD_ConfGeral[25]=203
                              CoresSD_ConfGeral[27]=203
                              CoresSD_ConfGeral[26]=203
                              CoresSD_ConfGeral[04]=202
                      EndIf     
          
                 OtherWise :
                      CoresSD_ConfGeral[01]=46
                      CoresSD_ConfGeral[05]=47
                      CoresSD_ConfGeral[14]=32
                      CoresSD_ConfGeral[02]=46
                      ;---- Para Montar a Lista -----------------------
                      If DISPLAY_ALT > 30
                         Then CoresSD_ConfGeral[25]=46   
                              CoresSD_ConfGeral[27]=46   
                              CoresSD_ConfGeral[26]=46   
                              CoresSD_ConfGeral[04]=32    
                         Else CoresSD_ConfGeral[25]=46  
                              CoresSD_ConfGeral[27]=46   
                              CoresSD_ConfGeral[26]=46   
                              CoresSD_ConfGeral[04]=32   
                      EndIf                                
               EndSwitch  
                                   
           OtherWise :
               CoresSD_ConfGeral[01]=79
               CoresSD_ConfGeral[05]=79
               CoresSD_ConfGeral[14]=64
               CoresSD_ConfGeral[02]=79
               ;---- Para Montar a Lista -----------------------
               If DISPLAY_ALT > 9
                  Then CoresSD_ConfGeral[25]=79   
                       CoresSD_ConfGeral[27]=79   
                       CoresSD_ConfGeral[26]=79   
                       CoresSD_ConfGeral[04]=74
                  Else CoresSD_ConfGeral[25]=79   ;Cor do Fundo da Lista
                       CoresSD_ConfGeral[27]=79   ;Cor da Barra Selecionada
                       CoresSD_ConfGeral[26]=79   ;Cor da Barra Selecionada
                       CoresSD_ConfGeral[04]=74   ;Barra de Rolagem
               EndIf                        
        EndSwitch
        
        Switch
          Case tpmsg="Memo" :
               WinArray8["CANMAXIMIZE"]=False
               WinArray8["CANCLOSE"]   =False
               WinArray8["Title"]      =titmsg
               WinArray8["HEIGHT"]     =DISPLAY_ALT
               WinArray8["WIDTH"]      =DISPLAY_LARG  
               WinArray8["ORIGINROW"]  =POSICAO_LIN
               WinArray8["ORIGINCOL"]  =POSICAO_COL
               WinArray8["HASFRAME" ] = True
               WinArray8["HASSHADOW"]  =True
               WinArray8["CANRESIZE"]  =True
               WinArray8["CANMOVE"]    =True
          OtherWise : If tpmsg="MsgHelp" Or tpmsg="Mensagem"
                         Then WinArray8["CANCLOSE"]=True
                         Else WinArray8["CANCLOSE"]=False
                      EndIf
        EndSwitch                 
        Window SetColors Janela_SD_ConfGeral     From CoresSD_ConfGeral
        Window SetAttributes JANELA_SD_ConfGeral From WinArray8

        Switch
          Case ConfGeralNao = "" : If tpmsg="Memo"
                                      Then Campo_SDCF="TG_Registro"
                                      Else Campo_SDCF="MENS_OK"
                                   EndIf    
          OtherWise              : Campo_SDCF="YES"
                                   If tpmsg="Confgeral" And ConfGeralNao="N" 
                                      Then Campo_SDCF="NO" 
                                   EndIf
        EndSwitch
        
        Message ""                                   
EndIf
If Disparo_SDCF="CLOSE" Then cancelDialog        EndIf

If Disparo_SDCF="EVENT" And Evento_SDCF["Type"]="KEY" Then
   Temp=False
   Switch
     Case Evento_SDCF["KeyCode"] = 27: 
          If Campo_SDCF="TG_Registro" 
             Then If ConfGeralNao = ""
                     Then If tpmsg="Memo"
                              Then CancelDialog
                              Else Campo_SDCF="MENS_OK"
                           EndIf    
                     Else If ConfGeralNao="N" 
                             Then Campo_SDCF="NO"
                             Else Campo_SDCF="YES"
                          EndIf 
                  EndIf
             Else CancelDialog     
          EndIf          
     Case Evento_SDCF["KeyCode"] = -75 Or Evento_SDCF["KeyCode"] = -77:
          Switch
            Case Campo_SDCF="NO"          : Campo_SDCF="YES"
            Case Campo_SDCF="YES"         : Campo_SDCF="NO"
          EndSwitch
     Case Evento_SDCF["KeyCode"] = 9 :
          Switch    
            Case Campo_SDCF="MENS_OK"     : If DISPLAY_ALT > 9
                                               Then Campo_SDCF="TG_Registro"
                                            EndIf 
            Case Campo_SDCF="TG_Registro" : If ConfGeralNao = ""
                                               Then If tpmsg="Memo"
                                                       Then Campo_SDCF="TG_Registro"
                                                       Else Campo_SDCF="MENS_OK"
                                                    EndIf
                                               Else If ConfGeralNao="N" 
                                                       Then Campo_SDCF="NO"
                                                       Else Campo_SDCF="YES"
                                                    EndIf 
                                            EndIf    
            Case Campo_SDCF="NO"          : If DISPLAY_ALT > 9
                                               Then Campo_SDCF="TG_Registro"
                                               Else Campo_SDCF="YES" 
                                            EndIf   
            Case Campo_SDCF="YES"         : Campo_SDCF="NO"   
          EndSwitch
          
     Case Evento_SDCF["KeyCode"] = 13:
          Switch                
            Case Campo_SDCF="TG_Registro" : If ConfGeralNao = ""
                                              Then If tpmsg="Memo"
                                                      Then Campo_SDCF="TG_Registro"
                                                      Else Campo_SDCF="MENS_OK"
                                                   EndIf    
                                              Else If ConfGeralNao="N" 
                                                      Then Campo_SDCF="NO"
                                                      Else Campo_SDCF="YES"
                                                   EndIf   
                                            EndIf  
            Case Campo_SDCF="NO"          : CancelDialog
            Case Campo_SDCF="YES"         : AcceptDialog
            ;Case Campo_SDCF="MENS_OK"     : AcceptDialog
          EndSwitch
     Case Evento_SDCF["KeyCode"] = 115 Or Evento_SDCF["KeyCode"] = 83:
          AcceptDialog
     Case Evento_SDCF["KeyCode"] = 110 Or Evento_SDCF["KeyCode"] = 78:
          CancelDialog
   EndSwitch
EndIf

SelectControl Campo_SDCF
Switch
  Case Campo_SDCF="TG_Registro"  : MSG_CAMPO="Informa‡”es! "
  Case Campo_SDCF="YES"          : MSG_CAMPO="Confirmar [S]=SIM !"
  Case Campo_SDCF="NO"           : MSG_CAMPO="  Ignorar [N]=NÇO !"
  Case Campo_SDCF="MENS_OK"      : MSG_CAMPO="Pressione a tecla [Esc] p/ continuar !                     "
EndSwitch

If ConfGeralNao = ""
   Then TECLA=" "
   Else TECLA=" "+"[TAB]=Alternar texto/bot„o "
EndIf
    
Switch
  Case (Campo_SDCF="YES" Or Campo_SDCF="NO") And ConfGeralNao <> "" : 
       TECLA=" "+Chr(27)+" "+Chr(26)+"/Tab=Seleciona  "
  Case Campo_SDCF="TG_Registro" And DISPLAY_ALT >9                      :
       TECLA = TECLA + " "+Chr(25)+Chr(24)+"=Rolar Texto"
       If tpmsg="Memo"
          Then TECLA = TECLA + "  "+"ESC=Retornar"
       EndIf   
EndSwitch   

ExibeRodapeSD_Mensagem()

RefreshDialog                         
                                     
Return Temp
EndProc ;SD_Mensagem()

;*******************************************************************************
;* Rotina Monta Janela de Mensagem                                             *
;*******************************************************************************
Proc Mensagem_Padrao(MSG)
Private MSG,titmsg, lin23, lin24

If Not IsAssigned(ConfGeralNao)     Then ConfGeralNao=""          EndIf  
If Not IsAssigned(ALINHA_TEXTO)     Then ALINHA_TEXTO = False     EndIf
If Not IsAssigned(CENTRALIZA_TEXTO) Then CENTRALIZA_TEXTO = False EndIf

tpmsg="Mensagem"
Switch
  Case IsAssigned(COR_MENSAGEM) : titmsg = "LEMBRETE !"
  Case ConfGeralNao="N"         : titmsg = "ALERTA !"
  OtherWise                     : titmsg = "ATEN€ŽO !"
EndSwitch

If ConfGeralNao <> ""
   Then tpmsg="Confgeral"
        TpSD_ConfGeral="Sim/Nao"
EndIf

If Not Monta_Mensagem_Lista(MSG)
   Then Release Vars TM_COL_QUEST,MSG_QUESTION,Array_Temp,TM_LARG,DISPLAY_ALT,TM_BTN1,TM_BTN2,
                     TM_FINAL,TM_INICIAL, COR_MENSAGEM, ConfGeralNao, titmsg, tpmsg 
        Return False
EndIf

Mouse Show
Sound 700 5

;---- Array das Mensagens --------------------------------------
DISPLAY_ALT = ArraySize(Array_Temp) + 5
DISPLAY_TAM = 0
For ii From 1 To ArraySize(Array_Temp)
  If Len(Rtrim(Array_Temp[ii])) > DISPLAY_TAM
     Then DISPLAY_TAM = Len(Rtrim(Array_Temp[ii]))
  EndIf   
Endfor
DISPLAY_TAM = DISPLAY_TAM + 4

If Len(MSG_QUESTION)>DISPLAY_TAM And ConfGeralNao<>""
   Then DISPLAY_TAM = Len(MSG_QUESTION) + 4
EndIf

If DISPLAY_TAM < 30 Then DISPLAY_TAM = 30 EndIf
If DISPLAY_TAM > 76 Then DISPLAY_TAM = 76 EndIf

DISPLAY_ARRAY = DISPLAY_TAM
 
If DISPLAY_ALT < 6  Then DISPLAY_ALT = 6  EnDIf
If DISPLAY_ALT > 19 
   Then DISPLAY_ALT = 20 
        DISPLAY_TAM = DISPLAY_TAM + 1 
        DISPLAY_ARRAY = DISPLAY_TAM-1
EndIf

TAMANHO_BUT_OK  = 11
TAMANHO_BUT_SIM = 11
TAMANHO_BUT_NAO = 11

TAMANHO_BUT_ESPACO = 3

DISPLAY_BUT_LIN     = DISPLAY_ALT - 4
DISPLAY_BUT_COL_OK  = Int((DISPLAY_TAM - (TAMANHO_BUT_OK))/2)
DISPLAY_BUT_COL_SIM = Int((DISPLAY_TAM - (TAMANHO_BUT_SIM + TAMANHO_BUT_NAO + TAMANHO_BUT_ESPACO))/2)
DISPLAY_BUT_COL_NAO = DISPLAY_BUT_COL_SIM + TAMANHO_BUT_NAO + TAMANHO_BUT_ESPACO
                                         
POSICAO_LIN = Int((24 - DISPLAY_ALT) / 2)
POSICAO_COL = Int((80 - DISPLAY_TAM) / 2)
DISPLAY_TXT = 5

;--- Pergunta p/ Questionamento -------------
DIPLAY_AUX   = 0
TM_COL_QUEST = 0
TM_ALT_QUEST = 0        
If MSG_QUESTION <> "" 
   Then If DISPLAY_ALT+2 > 19
           Then DISPLAY_ALT = 20
           Else DISPLAY_ALT = DISPLAY_ALT + 2 
        EndIf
        POSICAO_LIN = Int((24 - DISPLAY_ALT) / 2)        
        DISPLAY_TXT     = 6
        
        TM_ALT_QUEST    = DISPLAY_ALT-DISPLAY_TXT-1       
        If ArraySize(Array_Temp)>=14
           Then DISPLAY_ALT = DISPLAY_ALT - 1
                If ArraySize(Array_Temp)=14
                   Then DISPLAY_BUT_LIN = DISPLAY_BUT_LIN + 1
                EndIf    
                DIPLAY_AUX = 1
           Else DISPLAY_BUT_LIN = DISPLAY_BUT_LIN + 2
        EndIf   
        POSICAO_COL = POSICAO_COL - 1
        DISPLAY_TAM = DISPLAY_TAM + 2     
EndIf       

;---- Centralizar o Texto da Mensagem caso nÆo seja justificado -----------
;At‚ 18/10 o texto centralizado estava sendo processado para todas as mensagens, por‚m agora ser  por parƒemtro
;caso o texto tenha a necessidade de ser centralizado
If CENTRALIZA_TEXTO 
   Then For i From 1 To ArraySize(Array_Temp)
          Array_Temp[i] = Ltrim(Array_Temp[i])
        EndFor
EndIf        

If Not ALINHA_TEXTO
   Then For i From 1 To ArraySize(Array_Temp)
          AUX_CENTRALIZAR = Int((DISPLAY_TAM-4 - Len(Array_Temp[i])) / 2)
          If AUX_CENTRALIZAR > 0
             Then Array_Temp[i] = Spaces(AUX_CENTRALIZAR-1)+Array_Temp[i]
          EndIf
        EndFor
EndIf   

;@ 23,00 ?? "" lin23=cursorline()
;@ 24,00 ?? "" lin24=cursorline()

If ConfGeralNao=""
   Then ;---- Mensagem com um botÆo ---------
        Showdialog titmsg Proc "SD_Mensagem"
        Trigger "OPEN","ARRIVE"
        Key "ALL"

        @ POSICAO_LIN,POSICAO_COL Height DISPLAY_ALT+DIPLAY_AUX Width DISPLAY_TAM

        @ TM_ALT_QUEST+TM_COL_QUEST,02 ?? MSG_QUESTION

        PickArray @00,00 Height DISPLAY_ALT-DISPLAY_TXT width DISPLAY_ARRAY - 2
        Columns 1
          Array_Temp
           Tag "TG_Registro"
            To ArrayElement
            
        Pushbutton @ DISPLAY_BUT_LIN,DISPLAY_BUT_COL_OK Width TAMANHO_BUT_OK "~O~k"  OK  Default Value "Ok" Tag "MENS_OK" To BottonValue
        Enddialog 
   
   Else ;---- Mensagem com botÆo Sim e NAO -------------------------------------
        If ArraySize(Array_Temp)=1
           Then ;--- Quando ‚ apenas um array, o tratamento ‚ diferenciado -----  
                MSG_AUX = Array_Temp[1]
                
                Showdialog titmsg Proc "SD_Mensagem"
                Trigger "OPEN","ARRIVE"
                Key "TAB","ESC","ENTER","LEFT","RIGHT","S","s","N","n"
               
                @ POSICAO_LIN,POSICAO_COL Height DISPLAY_ALT+DIPLAY_AUX Width DISPLAY_TAM
              
                @ TM_ALT_QUEST+1+TM_COL_QUEST,01 ?? MSG_QUESTION
                @ DISPLAY_ALT-DISPLAY_TXT-2,01 ?? MSG_AUX
                        
                 Pushbutton @ DISPLAY_BUT_LIN,DISPLAY_BUT_COL_SIM     width TAMANHO_BUT_SIM     "~S~im"     OK  Default Value "Sim" Tag "YES" To BottonValue
                 Pushbutton @ DISPLAY_BUT_LIN,DISPLAY_BUT_COL_NAO     width TAMANHO_BUT_NAO     "~N~„o" CANCEL                      Tag "NO"  To BottonValue          
                                                                                                                             
                Enddialog
           Else Showdialog titmsg Proc "SD_Mensagem"
                Trigger "OPEN","ARRIVE"
                Key "TAB","ESC","ENTER","LEFT","RIGHT","S","s","N","n"
               
                @ POSICAO_LIN,POSICAO_COL Height DISPLAY_ALT+DIPLAY_AUX Width DISPLAY_TAM
              
                @ TM_ALT_QUEST+1+TM_COL_QUEST,01 ?? MSG_QUESTION
                
                PickArray @00,00 Height DISPLAY_ALT-DISPLAY_TXT width DISPLAY_ARRAY-2                                                                         
                Columns 1
                  Array_Temp
                   Tag "TG_Registro"
                    To ArrayElement
        
                 Pushbutton @ DISPLAY_BUT_LIN,DISPLAY_BUT_COL_SIM     width TAMANHO_BUT_SIM     "~S~im"     OK  Default Value "Sim" Tag "YES" To BottonValue
                 Pushbutton @ DISPLAY_BUT_LIN,DISPLAY_BUT_COL_NAO     width TAMANHO_BUT_NAO     "~N~„o" CANCEL                      Tag "NO"  To BottonValue          
                                                                                                                             
                Enddialog  
        EndIf
EndIf     
LimpaRodape(0)

Style Attribute 31
                
If RetVal
   Then OK="S"
   Else OK="N"
EndIf
LimpaRodape(0)

;ExibeRodape(1,lin23)
;ExibeRodape(2,lin24)

Release Vars MSG, NLinhas, Linha_Msg, LJM, CIM, COR_MENSAGEM,
             DISPLAY_ALT,DISPLAY_TAM,DISPLAY_ARRAY,TAMANHO_BUT_OK,TAMANHO_BUT_SIM,TAMANHO_BUT_NAO, 
             TAMANHO_BUT_ESPACO,DISPLAY_BUT_LIN,DISPLAY_BUT_COL_OK,DISPLAY_BUT_COL_SIM,DISPLAY_BUT_COL_NAO, 
             POSICAO_LIN,POSICAO_COL,DISPLAY_TXT,DIPLAY_AUX,TM_COL_QUEST,TM_ALT_QUEST,MSG_QUESTION,ALINHA_TEXTO,
             CENTRALIZA_TEXTO

Style Attribute 31
If OK="S"
   Then Return True
   Else Return False
EndIf
        
EndProc ;Mensagem_Padrao()
                    
;*******************************************************************************
;* Rotina p/ Montar a Mensagem                                                 *
;*******************************************************************************
Proc Monta_Mensagem_Lista(MSG)
Private Contador,PARAMETRO_CARACTER,MSG,NLinha,PosInicial,AUX_LIMITE,PosicaoC,
        PosInicial,AUX_ARRAY,Array_Temp2,TM_AUX,AUX_MSG,AUX_CONT
If Not IsAssigned(tpmsg)            Then tpmsg = ""               EndIf
If Not IsAssigned(ALINHA_TEXTO)     Then ALINHA_TEXTO = False     EndIf
If Not IsAssigned(CENTRALIZA_TEXTO) Then CENTRALIZA_TEXTO = False EndIf

;A PARTIR DE 17.11.2015 AS MENSAGENS TAMBEM PODERAO SER PASSADAS COMO PARAMETRO 
;SEM QUEBRAS E AUTOMATICAMENTE SE AJUSTARA EM QUANTAS LINHAS FOREM NECESSERIAS. 
;
;A VARIAVEL "ALINHA_TEXTO" SE RETORNADO COMO VERDADEIRO PODERA AUTOMATICAMENTE 
;ALINHAR O TEXTO TENDO OU NAO QUEBRA DE LINHAS.

;A VARIAVEL "CENTRALIZA_TEXTO" SE RETORNADO COMO VERDADEIRO PODERA AUTOMATICAMENTE 
;REMOVER OS ESPACAMENTOS µ ESQUERDA DO TEXTO, ASSIM SERA POSSIVEL CENTRALIZAR O TEXTO.

PARAMETRO_CARACTER = 72

;---- Quebra automatica de Linha -----------------------------------------------   
If Len(MSG) > PARAMETRO_CARACTER And Search("//",MSG)=0 And Search("\n",MSG)=0
   Then AUX_MSG="" 
        While True
          AUX_CONT = PARAMETRO_CARACTER 
          While True  
            If SubStr(MSG,AUX_CONT+1,1)=" " 
               Then AUX_MSG = AUX_MSG + SubStr(MSG,1,AUX_CONT)+"//"
                    MSG     = SubStr(MSG,AUX_CONT+1,Len(MSG))
                    QuitLoop
               Else AUX_CONT = AUX_CONT - 1
            EndIf    
          EndWhile
          If Len(MSG) < PARAMETRO_CARACTER + 2 
              Then MSG = AUX_MSG + MSG
                   QuitLoop
          EnDIf
        EndWhile 
EndIf

If ALINHA_TEXTO
   Then MSG = Alinha_Texto(MSG)
EndIf

;---- Apenas para LER_MEMO -> Monta registros quebrando linha a linha ------------------
If Isassigned(COR_MENSAGEM) And COR_MENSAGEM = "MEMO"  And Len(MSG) > PARAMETRO_CARACTER And (Search("//",MSG)>0 Or Search("\n",MSG)>0)
   Then CONT_LINHA = 0 
        AUX_MSG    = "" 
        CONT_MSG   = 0
        POSF       = 0         
        For wu From 1 To Len(MSG)
          If SubStr(MSG,wu,1)="\n" Or SubStr(MSG,wu,2)="//"
             Then CONT_LINHA = CONT_LINHA + 1
                  If CONT_MSG = 0 Then CONT_MSG = 1 POSF = wu-1 Else POSF = wu-1 - CONT_MSG+1 EndIf
                  AUX_MSG = AUX_MSG +  Ltrim(Rtrim(SubStr(MSG,CONT_MSG,POSF)))
                  AUX_MSG = AUX_MSG + "//"    
                  If SubStr(MSG,wu,2)="//"
                     Then CONT_MSG = wu+2
                          wu = wu + 1
                     Else CONT_MSG = wu+1
                  EndIf
          EndIf
          If wu=Len(MSG) Then MSG = AUX_MSG + SubStr(MSG,CONT_MSG,Len(MSG)) QuitLoop EndIf 
        EndFor
        
        If ALINHA_TEXTO
           Then AUX_MSG = ""
                CONT_MSG = 0 
                CONT_TM  = 0
                ;---- Verifica tamanho da maior linha para alinhameto-----------------------------------
                For wu From 1 To Len(MSG)
                  If SubStr(MSG,wu,1)="\n" Or SubStr(MSG,wu,1)="//"
                     Then If CONT_MSG = 0 Then CONT_MSG = 1 POSF = wu-1 Else POSF = wu-1 - CONT_MSG+1 EndIf
                          If Len(Ltrim(Rtrim(SubStr(MSG,CONT_MSG,POSF)))) > CONT_TM
                             Then CONT_TM = Len(Ltrim(Rtrim(SubStr(MSG,CONT_MSG,POSF))))
                          EndIf
                          CONT_MSG = wu+1
                  EndIf   
                Endfor
                
                ;---- Realiza o alinhameto ---------------------------------------------------------------
                If CONT_TM > 0 
                   Then For wu From 1 To Len(MSG)
                          If SubStr(MSG,wu,1)="\n" Or SubStr(MSG,wu,2)="//"
                             Then If CONT_MSG = 0 Then CONT_MSG = 1 POSF = wu-1 Else POSF = wu-1 - CONT_MSG+1 EndIf
                                   AUX_MSG = AUX_MSG +  Completa(Ltrim(Rtrim(SubStr(MSG,CONT_MSG,POSF))),CONT_TM," ")
                                   If SubStr(MSG,wu,2)="//"
                                      Then CONT_MSG = wu+2
                                           wu = wu + 1
                                      Else CONT_MSG = wu+1
                                   EndIf   
                                   If wu = Len(MSG) Then Quitloop Else AUX_MSG = AUX_MSG + "//" EndIf     
                          EndIf
                          If wu = Len(MSG) Then AUX_MSG = AUX_MSG + SubStr(MSG,CONT_MSG,Len(MSG)) QuitLoop EndIf
                        Endfor
                EndIf        
        EndIf
        Release Vars CONT_TM,CONT_LINHA,CONT_MSG,POSF,wu 
EndIf
  
DynArray Array_Temp2[]
NLinha     = 1
PosInicial = 1
AUX_LIMITE = False
While True
  PosicaoC = SearchFrom("//",MSG,PosInicial)
  If PosicaoC > 0
     Then AUX_ARRAY = SubStr(MSG,PosInicial,PosicaoC - PosInicial)
          If Len(AUX_ARRAY) > PARAMETRO_CARACTER
             Then AUX_LIMITE = True
                  While True
                    Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),2) + SubStr(AUX_ARRAY,1,PARAMETRO_CARACTER)
                    AUX_ARRAY = SubStr(AUX_ARRAY,PARAMETRO_CARACTER+1,Len(AUX_ARRAY))
                    If AUX_ARRAY = ""
                       Then QuitLoop
                    EndIf
                    NLinha = NLinha + 1    
                  EndWhile
             Else Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),2) + AUX_ARRAY
          EndIf         
          NLinha = NLinha+1
          PosInicial = PosicaoC + 2
     Else Array_Temp2[NLinha] = SubStr(MSG,PosInicial,Len(MSG))
          ;---- Quebra automatica de Linha -------------------------------------          
          CONTA_MSG = 0 
          MSG = Array_Temp2[NLinha]
          If Len(Array_Temp2[NLinha]) > PARAMETRO_CARACTER
             Then AUX_MSG="" 
                  While True
                    AUX_CONT = PARAMETRO_CARACTER 
                    While True  
                      If SubStr(MSG,AUX_CONT+1,1)=" " 
                         Then CONTA_MSG = CONTA_MSG + 1
                              If CONTA_MSG>1
                                 Then NLinha = NLinha + 1
                              EndIf
                              Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),2) + Ltrim(SubStr(MSG,1,AUX_CONT)) 
                              MSG     = SubStr(MSG,AUX_CONT+1,Len(MSG))
                              QuitLoop
                         Else AUX_CONT = AUX_CONT - 1
                      EndIf    
                    EndWhile
                    If Len(MSG) < PARAMETRO_CARACTER + 2 
                        Then CONTA_MSG = CONTA_MSG + 1
                             If CONTA_MSG>1
                                Then NLinha = NLinha + 1
                             EndIf
                             Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),2) + MSG
                             QuitLoop
                    EnDIf
                  EndWhile 
          EndIf
          Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),2) + MSG
          QuitLoop
  EndIf
EndWhile

;---- Tamanho do Array da Mensagem ---------------------------------------------
Contador = 0
For i From 1 To DynArraySize(Array_Temp2)
   If DynArraySize(Array_Temp2) = 1 Then QuitLoop EndIf
   Contador = Contador + 1
   If i = DynArraySize(Array_Temp2) And
      Search("?",Rtrim(Ltrim(SubStr(Array_Temp2[i],3,Len(Array_Temp2[i]))))) > 0 And
      ConfGeralNao<>""
      Then Contador = Contador - 1
   EndIf
Endfor 

If Contador > 0
   Then Array Array_Temp[Contador]
        Contador = 0
        MSG_QUESTION = ""
        For i From 1 To DynArraySize(Array_Temp2)
          If Search("?",SubStr(Array_Temp2[i],3,Len(Array_Temp2[i]))) > 0  And i = DynArraySize(Array_Temp2) And ConfGeralNao<>""
             Then MSG_QUESTION = SubStr(Array_Temp2[i],3,Len(Array_Temp2[i]))
                  QuitLoop
          EndIf    
          Contador = Contador + 1
          Array_Temp[Contador] = SubStr(Array_Temp2[i],3,Len(Array_Temp2[i]))    
        EndFor
   Else Array Array_Temp[2]
        Array_Temp[1] = ""
        MSG_QUESTION = ""
        If DynArraySize(Array_Temp2) = 1
           Then Array_Temp[2] = SubStr(Array_Temp2[1],3,Len(Array_Temp2[1]))
        EndIf
EndIf   

Release Vars Contador,PARAMETRO_CARACTER,MSG,NLinha,PosInicial,AUX_LIMITE,
             PosicaoC,PosInicial,AUX_ARRAY,Array_Temp2,TM_AUX
  
Return True

EndProc ;Monta_Mensagem_Lista()

;*******************************************************************************
;* Rotina p/ Alinhar Caracteres                                                *
;*******************************************************************************
Proc Alinha_Texto(MSG)
Private i,ii,MSG,AUX_MSG,AUX_CONT, PosI, ALINH_TEXTO,AUX_LARG,AUX_CONT,AUX_DEC

PARAMETRO_CARACTER = 72

AUX_MSG  = MSG
AUX_CONT = 0

While True
  PosI = Search("//",AUX_MSG)
  If PosI > 0
     Then AUX_CONT = AUX_CONT + 1
          AUX_MSG = SubStr(AUX_MSG,PosI+2,Len(AUX_MSG))
     Else AUX_CONT = AUX_CONT + 1     
  EndIf
  If PosI = 0 Then QuitLoop EndIf
EndWhile

Array ALINH_TEXTO[AUX_CONT]
AUX_MSG  = MSG
AUX_CONT = 0

While True
  PosI = Search("//",AUX_MSG)
  If PosI > 0
     Then AUX_CONT = AUX_CONT + 1
          ALINH_TEXTO[AUX_CONT] = Ltrim(SubStr(AUX_MSG,1,PosI-1))
          AUX_MSG = SubStr(AUX_MSG,PosI+2,Len(AUX_MSG))
     Else AUX_CONT = AUX_CONT + 1
          ALINH_TEXTO[AUX_CONT] = Ltrim(SubStr(AUX_MSG,1,Len(AUX_MSG)))     
  EndIf
  If PosI = 0 Then QuitLoop EndIf
EndWhile

Array TEMP_CONTADOR[AUX_CONT]

AUX_LARG = 0
For i From 1 To ArraySize(ALINH_TEXTO)
  If AUX_LARG < Len(ALINH_TEXTO[i])  
     Then AUX_LARG = Len(ALINH_TEXTO[i])
  EndIf
EndFor

MSG = ""
For i From 1 To ArraySize(ALINH_TEXTO)
  AUX_DEC = AUX_LARG - Len(ALINH_TEXTO[i])
  If AUX_DEC > 0 And i <> ArraySize(ALINH_TEXTO)
     Then For ii From 1 To Len(ALINH_TEXTO[i])+AUX_DEC 
            If SubStr(ALINH_TEXTO[i],ii,1) = " "
               Then ALINH_TEXTO[i] = SubStr(ALINH_TEXTO[i],1,ii)+" "+SubStr(ALINH_TEXTO[i],ii+1,Len(ALINH_TEXTO[i])+AUX_DEC+1)
                    ii = ii + 1
                    AUX_DEC = AUX_DEC - 1
            EndIf
            If ii = Len(ALINH_TEXTO[i]) And AUX_DEC > 0 Then ii = 1 EndIf
            If AUX_DEC = 0 Then QuitLoop EndIf
          EndFor
    Else If i = ArraySize(ALINH_TEXTO)
            Then ALINH_TEXTO[i] = Completa(ALINH_TEXTO[i],AUX_LARG," ") 
         EndIf 
  EndIf
  MSG = MSG + ALINH_TEXTO[i]
  If i <> ArraySize(ALINH_TEXTO) Then MSG = MSG + "//" EndIf
EndFor

Return MSG

EndProc ;Alinha_Texto()

;*******************************************************************************
;* ROTINA CONFGERAL DIALOG                                                     *
;*******************************************************************************
Proc SD_ConfGeral(Disparo_SDCF,Campo_SDCF,Evento_SDCF,Elemento_SDCF)
Private Disparo_SDCF,Campo_SDCF,Evento_SDCF,
        Elemento_SDCF,Temp,CoresSD_ConfGeral,
        TECLA, MSG_CAMPO
Temp=True
MSG_CAMPO=""
TECLA=""
If Disparo_SDCF="OPEN"
   Then 
        Window handle Dialog To Janela_SD_ConfGeral
        If IsAssigned(CoresSD_ConfGeral)
           Then Release Vars CoresSD_ConfGeral
        EndIf
        Dynarray WinArray8[]
        Dynarray CoresSD_ConfGeral[]

        If IsAssigned(COR_MENSAGEM) 
           Then If COR_MENSAGEM="ALERTA" 
                   Then CoresSD_ConfGeral[01]=249                               ;Borda e T¡tulo          Branco_Azul
                        CoresSD_ConfGeral[05]=240                               ;Frame/Textos            Branco_Preto
                        CoresSD_ConfGeral[09]=27                                ;Button Sem Sele‡Æo      Azul_Branco
                        CoresSD_ConfGeral[11]=26                                ;Button Selecionado      Azul_VerdeDest
                        CoresSD_ConfGeral[13]=26                                ;HotKey Button           Azul_VerdeDest                                                         
                        CoresSD_ConfGeral[14]=240                               ;Sombra Button           Branco_Preto
                   Else CoresSD_ConfGeral[01]=46 ;47
                        CoresSD_ConfGeral[05]=47 ;47
                        CoresSD_ConfGeral[14]=32 ;32
                        CoresSD_ConfGeral[02]=46   
                EndIf                      
           Else CoresSD_ConfGeral[01]=79
                CoresSD_ConfGeral[05]=79
                CoresSD_ConfGeral[14]=64
                CoresSD_ConfGeral[02]=79
        EndIf
        
        If tpmsg="MsgHelp" Or
           tpmsg="Mensagem"
           Then WinArray8["CANCLOSE"]=True
           Else WinArray8["CANCLOSE"]=False
        EndIf   
        Window SetColors Janela_SD_ConfGeral     From CoresSD_ConfGeral
        Window SetAttributes JANELA_SD_ConfGeral From WinArray8

        If tpmsg="Confgeral" And ConfGeralNao="N" Then Campo_SDCF="NO" EndIf
        
EndIf
If Disparo_SDCF="CLOSE" Then cancelDialog        EndIf

If Disparo_SDCF="EVENT" And Evento_SDCF["Type"]="KEY" Then
   Temp=False
   Switch
     Case Evento_SDCF["KeyCode"] = 27:
          CancelDialog
     Case Campo_SDCF="MENS_OK" :
         Sound 700 5
     Case Evento_SDCF["KeyCode"] = -75 Or Evento_SDCF["KeyCode"] = -77:
          If Campo_SDCF="NO"
             Then Campo_SDCF="YES"
             Else Campo_SDCF="NO"
          EndIf
     Case Evento_SDCF["KeyCode"] = 13:
          Switch
            Case Campo_SDCF="NO" : CancelDialog
            Case Campo_SDCF="YES": AcceptDialog
          EndSwitch
     Case Evento_SDCF["KeyCode"] = 115 Or Evento_SDCF["KeyCode"] = 83:
          AcceptDialog
     Case Evento_SDCF["KeyCode"] = 110 Or Evento_SDCF["KeyCode"] = 78:
          CancelDialog
   EndSwitch
EndIf

SelectControl Campo_SDCF
Switch
  Case Campo_SDCF="YES"    :  MSG_CAMPO="Confirmar [S]=SIM !"
  Case Campo_SDCF="NO"     :  MSG_CAMPO="  Ignorar [N]=NÇO !"
  Case Campo_SDCF="MENS_OK":  MSG_CAMPO="Pressione a tecla [Esc] p/ continuar !                     "
EndSwitch

If Campo_SDCF="YES" Or Campo_SDCF="NO"
   Then TECLA=" "+Chr(27)+" "+Chr(26)+"/Tab=Seleciona  "
   Else TECLA=" "
EndIf

ExibeRodapeSD(MSG_CAMPO)
ExibeRodape(2,TECLA)

RefreshDialog

Return Temp
EndProc

;******************************************
;* Rotina exibe string na linha do radape
;******************************************
Proc ExibeRodape(l,s)
Private l,s

If Not IsAssigned(SYS_COR_RODAPE) 
   Then SYS_COR_RODAPE =31 
        SYS_COR_RODAPED=30 
EndIf
Switch
  Case l=1:
    @ 23,0 ?? " "+Completa(s,79," ")
    PaintCanvas Attribute SYS_COR_RODAPED 23,0,23,79
  Case l=2:
    @ 24,0 ?? " "+Completa(s,79," ")
    PaintCanvas Attribute SYS_COR_RODAPE  24,0,24,79
EndSwitch
EndProc

;******************************************
;* Rotina exibe rodape showdialog         *
;******************************************
Proc MontaRodapeSD(msg, tecla)
Private msg, tecla

If Not IsAssigned(SYS_COR_RODAPE) 
   Then SYS_COR_RODAPE =31 
        SYS_COR_RODAPED=30 
EndIf

@ 23,0 ?? ">"+Completa(msg,79," ")
PaintCanvas Attribute SYS_COR_RODAPED 23,0,23,79

@ 24,0 ?? " "+Completa(tecla,79," ")
PaintCanvas Attribute SYS_COR_RODAPE  24,0,24,79

EndProc

;******************************************
;* Rotina exibe string na linha do radape
;******************************************
Proc ExibeRodapeSD(s)
Private s, posi

If Not IsAssigned(SYS_COR_RODAPE) 
   Then SYS_COR_RODAPE =31
        SYS_COR_RODAPED=30 
EndIf

if s="//" 
   then s="" 
   else s=">"+s
endif

If Not IsBlank(s)
  Then If s<>"."
          Then
             If Search("[Esc]",s)=0
                Then 
                     ;;;;;s=s+" [ENTER] "
             EndIf   
          Else s=s+Fill(" ",79)
       EndIf
EndIf

@ 23,0 ?? Format("W80,AL",s)
PaintCanvas Attribute SYS_COR_RODAPED 23,00,23,79
PaintCanvas Attribute SYS_COR_RODAPE  24,00,24,79

posi=searchfrom("[Esc]",s,1)
;;;;;if posi=0  then posi=searchfrom("[ENTER]",s,1) endif
if posi>0  then posi=posi-1                    endif
if posi>79 then posi=79                        endif

;;;;;PaintCanvas Attribute SYS_COR_RODAPE  23,posi,23,79

EndProc

;*******************************************************************************
;* Exibe Rodape Mensagem                                                       *
;*******************************************************************************
Proc ExibeRodapeSD_Mensagem()
Private s, posi, tmc, cor

If IsAssigned(COR_MENSAGEM) 
   Then If COR_MENSAGEM="ALERTA" 
           Then cor=249                               
           Else cor=47
        EndIf                      
   Else cor=79
EndIf


If Not IsBlank(MSG_CAMPO)
  Then If MSG_CAMPO<>"."
          Then 
               ;;;;;If Search("[Esc]",MSG_CAMPO)=0
               ;;;;;   Then MSG_CAMPO=MSG_CAMPO+" [ENTER] "
               ;;;;;EndIf   
          Else MSG_CAMPO=Fill(" ",80)
       EndIf
EndIf

s=Format("W80,AC",ltrim(Rtrim(MSG_CAMPO)))
@ 23,0 ?? s
PaintCanvas Attribute (cor-1) 23,00,23,79

;;;;;tmc=0
;;;;;posi=searchfrom("[Esc]",s,1)
;;;;;if posi>0 
;;;;;   then tcm=4
;;;;;   else
        ;;;;;posi=searchfrom("[ENTER]",s,1)
        ;;;;;if posi>0                 
        ;;;;;   then tcm=6
        ;;;;;endif
;;;;;endif
;;;;;if posi>0  then posi=posi-1            endif
;;;;;if posi>73 then posi=73                endif

;;;;;PaintCanvas Attribute  cor    23,posi,23,posi+tcm
;;;;;PaintCanvas Attribute  cor    23,00,23,79

@ 24,0 ?? " "+Completa(TECLA,79," ")
PaintCanvas Attribute cor 24,0,24,79

EndProc

;******************************************
;* Rotina Limpa rodape                     
;******************************************
Proc LimpaRodape(l)
Private l

If Not IsAssigned(SYS_COR_RODAPE) 
   Then SYS_COR_RODAPE =31
        SYS_COR_RODAPED=30 
EndIf
Switch
  Case l=0:
    @ 23,0 ?? Fill(" ",80)
    @ 24,0 ?? Fill(" ",80)
    PaintCanvas Attribute SYS_COR_RODAPE 23,0,24,79
  Case l=1:
    @ 23,0 ?? Fill(" ",80)
    PaintCanvas Attribute SYS_COR_RODAPE 23,0,23,79
  Case l=2:
    @ 24,0 ?? Fill(" ",80)
    PaintCanvas Attribute SYS_COR_RODAPE 24,0,24,79
EndSwitch
EndProc

;************************************
;* ROTINA PARA MENSAGEM DE AGUARDE  *
;************************************
Proc Aguarde(s)
Private s
ExibeRodape(2,s+"...")
EndProc

;************************************
;* ROTINA PARA MENSAGEM DE AGUARDE  *
;************************************
Proc Aguardes(s)
Private s
ExibeRodape(1,s+"...")
EndProc

;*******************************************
;* ROTINA PARA LIMPAR MENSAGEM DE AGUARDE  *
;*******************************************
Proc LimpAguarde()
LimpaRodape(2)
EndProc

;*******************************************
;* ROTINA PARA LIMPAR MENSAGEM DE AGUARDE  *
;*******************************************
Proc LimpAguardes()
LimpaRodape(1)
EndProc

;*****************************************************
;* ROTINA PARA ALINHAMENTO DE CAMPO EM TABELA/FORMS  *
;*****************************************************
Proc Alinh()
Private TIPO,AUXI,TAMAN,LETR,FALT,ZERO
TIPO=FIELDTYPE()
AUXI=LEN(TIPO)
TAMAN=SUBSTR(TIPO,2,AUXI-1)
TAMAN=NUMVAL(TAMAN)

LETR=LEN([])
FALT=TAMAN-LETR
ZERO=FILL("0",FALT)
RETOR=ZERO+[]
RETURN RETOR
EndProc

;****************************************************
;** ROTINA PARA ALINHAMENTO DE VARIAVEL DE MEMORIA **
;****************************************************
Proc AlinhM(VR,TAMAN)
Private LETR,FALT,TAMAN,VR,ZERO
LETR=Len(VR)
FALT=TAMAN-LETR
ZERO=Fill("0",FALT)
NVR=ZERO+VR
Return NVR
EndProc

;****************************************************
;** ROTINA PARA ALINHAMENTO DE VARIAVEL DE MEMORIA **
;****************************************************
Proc Completa(VR,TAMAN,COMPLETA)
Private Vr,Taman,Completa
LETR=Len(VR)
FALT=TAMAN-LETR
If FALT > 0
   Then ZERO=Fill(COMPLETA,FALT)
        NVR=VR + ZERO
   Else NVR = SUBSTR(VR,1,TAMAN)
EndIf
Return NVR
EndProc

;****************************************************
;** ROTINA PARA ALINHAMENTO DE VARIAVEL DE MEMORIA **
;****************************************************
Proc AlVar(VR,TAMAN,COMPLETA)
Private Vr,Taman,Completa
LETR=Len(VR)
FALT=TAMAN-LETR
If FALT > 0
   Then ZERO=Fill(COMPLETA,FALT)
        NVR=ZERO+VR
   Else NVR = SUBSTR(VR,1,TAMAN)
EndIf
Return NVR

EndProc

;************************************
;* ROTINA PARA CHECAGEM CGC         *
;************************************
Proc ChecaCGC(CGC)
Private I,DF1,RESTO1,PRIDIG,RESTO2,SEGDIG
ARRAY d[12]

FOR I FROM 1 TO 12
 d[I]=numval(substr(cgc,i,1))
ENDFOR
;*** TESTE DO PRIMEIRO DIGITO (UNIDADE)
DF1 = 5 * d[1] + 4 * d[2]+ 3 * d[3]+ 2 * d[4]+ 9 * d[5]+ 8 * d[6]+ 7 * d[7]+ 6 * d[8]+ 5 * d[9]+ 4 * d[10]+ 3 * d[11] + 2 * d[12]
RESTO1 = MOD(DF1,11)
If RESTO1=0  OR  RESTO1=1
   Then PRIDIG = 0
 Else
   PRIDIG = 11-RESTO1
EndIf
;*** TESTE DO SEGUNDO DIGITO (DEZENA)
DF1 = 6 * d[1]+ 5 * d[2]+4 * d[3]+ 3 * d[4]+  2 * d[5]+ 9 * d[6]+ 8 * d[7]+ 7 * d[8]+ 6 * d[9]+ 5 * d[10]+ 4 * d[11]+ 3 * d[12]+ 2 * PRIDIG
RESTO2 =MOD(DF1,11)
If RESTO2=0  OR  RESTO2=1
   Then SEGDIG = 0
 Else
   SEGDIG = 11-RESTO2
EndIf
;*** TESTA A CONSISTENCIA DO CGC
If PRIDIG<>NUMVAL(SUBSTR(CGC,13,1)) OR SEGDIG<>NUMVAL(SUBSTR(CGC,14,1))
   Then WB=1
   Else WB=0
EndIf
EndProc

;************************************
;* ROTINA PARA CHECAGEM CPF         *
;************************************
Proc ChecaCPF(CPF)
Private I,DF1,PRIDIG,RESTO1,RESTO2,SEGDIG
ARRAY d[9]
FOR I FROM 1 TO 9
 d[I]=numval(substr(cpf,i,1))
ENDFOR
;*** TESTE DO PRIMEIRO DIGITO (UNIDADE)
DF1 = 1 * d[1] + 2 * d[2]+ 3 * d[3]+ 4 * d[4]+ 5 * d[5]+ 6 * d[6]+ 7 * d[7]+ 8 * d[8]+ 9 * d[9]
RESTO1 = MOD(DF1,11)
If RESTO1=0  OR  RESTO1=10
   Then PRIDIG = 0
 Else
   PRIDIG = RESTO1
EndIf
;*** TESTE DO SEGUNDO DIGITO (DEZENA)
FOR I FROM 2 TO 9
 d[I-1]=d[I]
ENDFOR
d[9]=PRIDIG
DF1 = 1 * d[1] + 2 * d[2]+ 3 * d[3]+ 4 * d[4]+ 5 * d[5]+ 6 * d[6]+ 7 * d[7]+ 8 * d[8]+ 9 * d[9]
RESTO2 =MOD(DF1,11)
If RESTO2=0  OR  RESTO2=10
   Then SEGDIG = 0
 Else
   SEGDIG = RESTO2
EndIf
;*** TESTA A CONSISTENCIA DO CGC
If PRIDIG<>NUMVAL(SUBSTR(CPF,10,1)) OR SEGDIG<>NUMVAL(SUBSTR(CPF,11,1))
   Then WB=1
   Else WB=0
EndIf
EndProc

;*****************************************
; Checagem de CGG ou CPF Formatado       *
;*****************************************
Proc Checa_CGC_CPF_Formatado(Campo_CGC_CPF)
Private Campo_CGC_CPF, Validar
;validar cgc/cpf
;123456789012345678
;##.###.###/####-##  CGC
;12345678901234
;###.###.###-##      CPF

Validar=False
If SubStr(Campo_CGC_CPF,03,1)="." and
   SubStr(Campo_CGC_CPF,07,1)="." and
   SubStr(Campo_CGC_CPF,11,1)="/" and
   SubStr(Campo_CGC_CPF,16,1)="-"
   Then WVR=""               ;CGC
        WVR=SubStr(Campo_CGC_CPF,01,2)+
            SubStr(Campo_CGC_CPF,04,3)+
            SubStr(Campo_CGC_CPF,08,3)+
            SubStr(Campo_CGC_CPF,12,4)+
            SubStr(Campo_CGC_CPF,17,2)
        If E_Numerico(WVR)
           Then CHECACGC(WVR)
                If WB=0
                   Then Validar=True
                EndIf
        EndIf
   Else If SubStr(Campo_CGC_CPF,04,1)="." and
           SubStr(Campo_CGC_CPF,08,1)="." and
           SubStr(Campo_CGC_CPF,12,1)="-"
           Then WVR=""               ;CPF
                WVR=SubStr(Campo_CGC_CPF,01,3)+
                    SubStr(Campo_CGC_CPF,05,3)+
                    SubStr(Campo_CGC_CPF,09,3)+
                    SubStr(Campo_CGC_CPF,13,2)
                If E_Numerico(WVR)
                   Then CHECACPF(WVR)
                        If WB=0
                           Then Validar=True
                        EndIf
                EndIf
        EndIf
EndIf
If Not Validar
   Then Mensagem("CNPJ/CPF inv lido !// ou (Formato CNPJ=##.###.###/####-##, CPF=###.###.###-##) Incorreto !")
EndIf
Return Validar
EndProc

;*****************************************
; Returna Tipo CGG ou CPF                *
;*****************************************
Proc Tipo_CGC_CPF(Campo_CGC_CPF)
Private Campo_CGC_CPF, Tipo
Tipo=""
If SubStr(Campo_CGC_CPF,03,1)="." and
   SubStr(Campo_CGC_CPF,07,1)="." and
   SubStr(Campo_CGC_CPF,11,1)="/" and
   SubStr(Campo_CGC_CPF,16,1)="-"
   Then WVR=""               ;CGC
        WVR=SubStr(Campo_CGC_CPF,01,2)+
            SubStr(Campo_CGC_CPF,04,3)+
            SubStr(Campo_CGC_CPF,08,3)+
            SubStr(Campo_CGC_CPF,12,4)+
            SubStr(Campo_CGC_CPF,17,2)
        CHECACGC(WVR)
        If WB=0 Then TIPO="CGC" EndIf
   Else If SubStr(Campo_CGC_CPF,04,1)="." and
           SubStr(Campo_CGC_CPF,08,1)="." and
           SubStr(Campo_CGC_CPF,12,1)="-"
           Then WVR=""               ;CPF
                WVR=SubStr(Campo_CGC_CPF,01,3)+
                    SubStr(Campo_CGC_CPF,05,3)+
                    SubStr(Campo_CGC_CPF,09,3)+
                    SubStr(Campo_CGC_CPF,13,2)
                CHECACPF(WVR)
                If WB=0 Then TIPO="CPF" EndIf
        EndIf
EndIf
Return Tipo
EndProc

;*****************************************
; ESCREVE VALOR DA CENTENA POR EXTENSO
;*****************************************
Proc Centena()
Switch
  Case CENTE="1":
       If DEZE="0" and UNID="0"
          Then EXTCEN="CEM "
          Else EXTCEN="CENTO "
       EndIf
  Case CENTE="2": EXTCEN="DUZENTOS "
  Case CENTE="3": EXTCEN="TREZENTOS "
  Case CENTE="4": EXTCEN="QUATROCENTOS "
  Case CENTE="5": EXTCEN="QUINHENTOS "
  Case CENTE="6": EXTCEN="SEISCENTOS "
  Case CENTE="7": EXTCEN="SETECENTOS "
  Case CENTE="8": EXTCEN="OITOCENTOS "
  Case CENTE="9": EXTCEN="NOVECENTOS "
  Case CENTE="0": EXTCEN=""
EndSwitch
EndProc

;*****************************************
; ESCREVE VALOR DA DEZENA POR EXTENSO
;*****************************************
Proc Dezena()
Switch
Case DEZE="1":
     Switch
       Case UNID="0": EXTDEZ="DEZ "
       Case UNID="1": EXTDEZ="ONZE "
       Case UNID="2": EXTDEZ="DOZE "
       Case UNID="3": EXTDEZ="TREZE "
       Case UNID="4": EXTDEZ="QUATORZE "
       Case UNID="5": EXTDEZ="QUINZE "
       Case UNID="6": EXTDEZ="DEZESSEIS "
       Case UNID="7": EXTDEZ="DEZESSETE "
       Case UNID="8": EXTDEZ="DEZOITO "
       Case UNID="9": EXTDEZ="DEZENOVE "
     EndSwitch
Case DEZE="2": EXTDEZ="VINTE "
Case DEZE="3": EXTDEZ="TRINTA "
Case DEZE="4": EXTDEZ="QUARENTA "
Case DEZE="5": EXTDEZ="CINQUENTA "
Case DEZE="6": EXTDEZ="SESSENTA "
Case DEZE="7": EXTDEZ="SETENTA "
Case DEZE="8": EXTDEZ="OITENTA "
Case DEZE="9": EXTDEZ="NOVENTA "
Case DEZE="0": EXTDEZ=""
EndSwitch
EndProc

;*****************************************
; ESCREVE VALOR DA UNIDADE POR EXTENSO
;*****************************************
Proc Unidade()
If DEZE<>"1"
   Then Switch
          Case UNID="1": EXTUNI="HUM "
          Case UNID="2": EXTUNI="DOIS "
          Case UNID="3": EXTUNI="TRES "
          Case UNID="4": EXTUNI="QUATRO "
          Case UNID="5": EXTUNI="CINCO "
          Case UNID="6": EXTUNI="SEIS "
          Case UNID="7": EXTUNI="SETE "
          Case UNID="8": EXTUNI="OITO "
          Case UNID="9": EXTUNI="NOVE "
          Case UNID="0": EXTUNI=""
        EndSwitch
   Else EXTUNI=""
EndIf
EndProc

;******************************************
; ESCREVE VALOR POR EXTENSO
;******************************************
Proc EscExt(VALOR)
ReadLib "\\Sistemas\\Cadastro\\Bibliot" CENTENA,DEZENA,UNIDADE
VALOR=STRVAL(VALOR)
VALOR  =Fill("0",15-Len(Valor))+VALOR
BILHAO =Substr(Valor,1,3)
MILHAO =Substr(Valor,4,3)

MIL    =Substr(Valor,7,3)
CRUZE  =Substr(Valor,10,3)
CENTA  =Substr(Valor,14,2)
EXTENSO=""
EXTDEZ=""
If BILHAO="000"
   Then EXTENSO=""
   Else CENTE=Substr(BILHAO,1,1)
        DEZE =Substr(BILHAO,2,1)
        UNID =Substr(BILHAO,3,1)
        CENTENA()
        DEZENA()
        UNIDADE()
        EXTENSO=EXTENSO+EXTCEN
        If EXTCEN<>""
           Then If EXTDEZ<>""
                   Then EXTENSO=EXTENSO+"E "+EXTDEZ
                EndIf
           Else EXTENSO=EXTENSO+EXTDEZ
        EndIf
        If EXTCEN<>"" or EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
        If BILHAO="001"
           Then EXTENSO=EXTENSO+"BILHAO"
           Else EXTENSO=EXTENSO+"BILHOES"
        EndIf
EndIf

If MILHAO<>"000"
   Then CENTE=Substr(MILHAO,1,1)
        DEZE =Substr(MILHAO,2,1)
        UNID =Substr(MILHAO,3,1)
        CENTENA()
        DEZENA()
        UNIDADE()
        If EXTENSO<>""
           Then EXTENSO=EXTENSO+", "
           Else EXTENSO=EXTENSO+" "
        EndIf
        EXTENSO=EXTENSO+EXTCEN
        If EXTCEN<>""
           Then If EXTDEZ<>""
                   Then EXTENSO=EXTENSO+"E "+EXTDEZ
                EndIf
           Else EXTENSO=EXTENSO+EXTDEZ
        EndIf
        If EXTCEN<>"" or EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
        If MILHAO="001"
           Then EXTENSO=EXTENSO+"MILHAO"
           Else EXTENSO=EXTENSO+"MILHOES"
        EndIf
EndIf

If MIL<>"000"
   Then CENTE=Substr(MIL,1,1)
        DEZE =Substr(MIL,2,1)
        UNID =Substr(MIL,3,1)
        CENTENA()
        DEZENA()
        UNIDADE()
        If EXTENSO<>""
           Then EXTENSO=EXTENSO+", "
           Else EXTENSO=EXTENSO+" "
        EndIf
        EXTENSO=EXTENSO+EXTCEN
        If EXTCEN<>""
           Then If EXTDEZ<>""
                   Then EXTENSO=EXTENSO+"E "+EXTDEZ
                EndIf
           Else EXTENSO=EXTENSO+EXTDEZ
        EndIf
        If EXTCEN<>"" or EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
        EXTENSO=EXTENSO+"MIL"
EndIf

If CRUZE<>"000"
   Then CENTE=Substr(CRUZE,1,1)
        DEZE =Substr(CRUZE,2,1)
        UNID =Substr(CRUZE,3,1)
        CENTENA()
        DEZENA()
        UNIDADE()
        If EXTENSO<>""
           Then EXTENSO=EXTENSO+", "
           Else EXTENSO=EXTENSO+" "
        EndIf
        EXTENSO=EXTENSO+EXTCEN
        If EXTCEN<>""
           Then If EXTDEZ<>""
                   Then EXTENSO=EXTENSO+"E "+EXTDEZ
                EndIf
           Else
                 EXTENSO=EXTENSO+EXTDEZ

        EndIf
        If EXTCEN<>"" or EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
        If CRUZE="001"
           Then EXTENSO=EXTENSO+"REAL "
           Else EXTENSO=EXTENSO+"REAIS "
        EndIf
   Else If EXTENSO<>""
           Then If MIl<>"000"
                   Then EXTENSO=EXTENSO+" REAIS "
                   Else EXTENSO=EXTENSO+" DE REAIS "
                EndIf
        EndIf
EndIf

If CENTA<>"00"
   Then DEZE =Substr(CENTA,1,1)
        UNID =Substr(CENTA,2,1)
        DEZENA()
        UNIDADE()
        If EXTENSO<>""
           Then EXTENSO=EXTENSO+"E "
        EndIf
        EXTENSO=EXTENSO+EXTDEZ
        If EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
        If CENTA="01"
           Then EXTENSO=EXTENSO+"CENTAVO"
           Else EXTENSO=EXTENSO+"CENTAVOS"
        EndIf
EndIf
EXTENSO=EXTENSO+Fill("*",225-Len(EXTENSO))
Release Procs CENTENA,DEZENA,UNIDADE
EndProc

;*****************************************
;*  ROTINA PARA MES EXTENSO             **
;*****************************************
Proc MesExt(MEST)
Private MEST
Switch
  Case MEST=1 : MESEX="JANEIRO "
  Case MEST=2 : MESEX="FEVEREIRO "
  Case MEST=3 : MESEX="MARCO "
  Case MEST=4 : MESEX="ABRIL "
  Case MEST=5 : MESEX="MAIO "
  Case MEST=6 : MESEX="JUNHO "
  Case MEST=7 : MESEX="JULHO "
  Case MEST=8 : MESEX="AGOSTO "
  Case MEST=9 : MESEX="SETEMBRO "
  Case MEST=10: MESEX="OUTUBRO "
  Case MEST=11: MESEX="NOVEMBRO "
  Case MEST=12: MESEX="DEZEMBRO "
  OtherWise:
       MESEX=""
EndSwitch
Return MESEX
EndProc

;*****************************************
;*  ROTINA PARA DIA EXTENSO             **
;*****************************************
Proc DiaExt(DIAEST)
Private DIAEST
DIAEST = Dow(DIAEST)
Switch
  Case DIAEST="Sun": DIAEXT="Domingo"
  Case DIAEST="Mon": DIAEXT="Segunda"
  Case DIAEST="Tue": DIAEXT="Terca"
  Case DIAEST="Wed": DIAEXT="Quarta"
  Case DIAEST="Thu": DIAEXT="Quinta"
  Case DIAEST="Fri": DIAEXT="Sexta"
  Case DIAEST="Sat": DIAEXT="Sabado"
EndSwitch
Return DIAEXT
EndProc

;******************************************
; ESCREVE DATA POR EXTENSO
;******************************************
Proc DatExt(DataRef)
Private DataRef,Extenso2,Valor
ReadLib "\\Sistemas\\Cadastro\\Bibliot" CENTENA,DEZENA,UNIDADE

EXTENSO2=""
EXTENSO =""
VALOR=AlinhM(LTrim(Format("D13",DataRef)),10)

DEZE =Substr(Valor,1,1)
UNID =Substr(Valor,2,1)
DEZENA()
If EXTDEZ<>""
   Then EXTENSO2=EXTENSO2+EXTDEZ
EndIf
UNIDADE()
If EXTUNI<>""
   Then EXTENSO2=EXTENSO2+EXTUNI
EndIf
EXTENSO2=EXTENSO2+"DE "
EXTENSO2=EXTENSO2+MesExt(Month(DataRef))+"DE "

EXTENSO=""
MIL    =Substr(Valor,7,1)
CENTENA=Substr(Valor,8,3)
If MIL<>"0"
   Then DEZE =""
        UNID =MIL
        UNIDADE()
        EXTENSO=EXTUNI+"MIL"
EndIf

If CENTENA<>"000"
   Then CENTE=Substr(CENTENA,1,1)
        DEZE =Substr(CENTENA,2,1)
        UNID =Substr(CENTENA,3,1)
        CENTENA()
        DEZENA()
        UNIDADE()
        If EXTCEN<>""
           Then If EXTUNI<>"" Or EXTDEZ<>""
                   Then EXTENSO=EXTENSO+", "
                   Else EXTENSO=EXTENSO+" E "
                EndIf
           Else If EXTUNI<>"" Or EXTDEZ<>""
                   Then EXTENSO=EXTENSO+" E "
                EndIf
        EndIf
        EXTENSO=EXTENSO+EXTCEN
        If EXTCEN<>""
           Then If EXTDEZ<>""
                   Then EXTENSO=EXTENSO+"E "+EXTDEZ
                EndIf
           Else EXTENSO=EXTENSO+EXTDEZ
        EndIf
        If EXTCEN<>"" or EXTDEZ<>""
           Then If EXTUNI<>""
                   Then EXTENSO=EXTENSO+"E "+EXTUNI
                EndIf
           Else EXTENSO=EXTENSO+EXTUNI
        EndIf
EndIf

EXTENSO=EXTENSO2+EXTENSO+Fill("*",225-Len(EXTENSO2+EXTENSO))
Release Procs CENTENA,DEZENA,UNIDADE,ESCEXT
EndProc

;*******************************************************************************
;* Rotina Encriptografar Senha dos Usuarios                                    *
;*******************************************************************************
Proc EncriptaSenha(SENHA)
Private CODIGOSUM,CONTADOR,CARACTER
CODIGOSUM=0
For CONTADOR From 1 To Len(SENHA)
    CARACTER = Asc(Substr(SENHA,CONTADOR,1))
    CODIGOSUM=CODIGOSUM+(CARACTER*CONTADOR)
EndFor
SENHAENC=StrVal(CODIGOSUM)
Return SENHAENC
EndProc

;*******************************************************************************
;* Rotina Para Limpa Area de Trabalho                                          *
;*******************************************************************************
Proc Limpa(nl,nc)
Private nl,nc

If Not IsAssigned(SYS_COR_FUNDO) Then SYS_COR_FUNDO=135 EndIf

While nl < 23
   PaintCanvas Border Fill Chr(176) Attribute SYS_COR_FUNDO nl, nc, nl, 79
;;   PaintCanvas Border Fill " " Attribute SYS_COR_FUNDO nl, nc, nl, 79
   nl=nl+1
EndWhile
Style
EndProc   ; (Limpa)

;*******************************************************************************
;* Checagem de Erros                                                           *
;*******************************************************************************
Proc ErroValid()
Private ErrorProc,ERROM,OK,Opcaoc,msgerro,valor,ArrayVal,varlorc,
        Tabela,MENSAGEM,TAMANHO,Array_Mensagem,ii,PosI,CONTA_ARRAY,s

If IMAGETYPE()="None"
   Then Tabela = ""
   Else Tabela = Table()
EndIf
   
If Not IsAssigned(SYS_CHAPA_USUARIO)   Then SYS_CHAPA_USUARIO =""  EndIf
If Not IsAssigned(SYS_NOME_USUARIO)    Then SYS_NOME_USUARIO  =""  EndIf
If Not IsAssigned(SYS_ESTACAO)         Then SYS_ESTACAO       =""  EndIf

DELIMITADOR = ";"

ErrorInfo To Infoerro
s=Format("D13",Today())+DELIMITADOR
s=s+Time()+DELIMITADOR
s=s+SYS_CHAPA_USUARIO+DELIMITADOR
s=s+Completa(SubStr(SYS_NOME_USUARIO,1,10),10," ")+DELIMITADOR
s=s+Completa(SubStr(SYS_ESTACAO,1,12),12," ")+DELIMITADOR
s=s+Completa(infoErro["SCRIPT"],30," ")+DELIMITADOR
s=s+StrVal(infoErro["LINE"])+DELIMITADOR
s=s+StrVal(infoErro["POSITION"])+DELIMITADOR
s=s+infoErro["PROC"]+DELIMITADOR
s=s+StrVal(infoErro["CODE"])+DELIMITADOR
s=s+infoErro["USER"]+DELIMITADOR
s=s+infoErro["MESSAGE"]

Array ERROM[67]
ERROM[01] = "Drive Despreparado"
ERROM[02] = "Diret¢rio n„o Encontrado"                                                     
ERROM[03] = "Tabela em uso pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]"
ERROM[04] = "Bloqueio completo de Tabela(s) em uso pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]"
ERROM[05] = "Arquivo n„o Encontrado"
ERROM[06] = "Arquivo Corrompido"
ERROM[07] = "Arquivo de Indice Corrompido"
ERROM[08] = "Erro na Vers„o do Objeto"
ERROM[09] = "Registro em uso pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]"
ERROM[10] = "Diret¢rio em uso pelo usu rio " +Upper(ErrorUser())+" !"
ERROM[11] = "Diret¢rio privativo do usu rio " +Upper(ErrorUser())+" !"
ERROM[12] = "Acesso negado ao Diret¢rio ao N¡vel do DOS"
ERROM[13] = "Indice Inconsistente com a Ordem de Classifica‡„o"
ERROM[14] = "Acesso MultiUsu rio Negado"
ERROM[15] = "Conflito com Arquivo Paradox.Net"
ERROM[16] = ""
ERROM[17] = ""
ERROM[18] = ""
ERROM[19] = ""
ERROM[20] = "Contexto inv lido para a Opera‡„o"
ERROM[21] = "Direitos de Senha Insuficientes"
ERROM[22] = "Tabela Protegida Contra Grava‡„o"
ERROM[23] = "Valor de Campo inv lido "
ERROM[24] = "Biblioteca de Procedure Obsoleta"
ERROM[25] = "Direitos … Imagem Insuficientes"
ERROM[26] = "Contexto inv lido da PAL"
ERROM[27] = "Opera‡„o n„o Conclu¡da"
ERROM[28] = "Excesso de Procedures Fechadas Agrupadas"
ERROM[29] = "Tabela Remota"
ERROM[30] = "Tipo de Dado n„o Correspondente"
ERROM[31] = "Argumento Fora da Faixa"
ERROM[32] = "Quantidade Incorreta de Argumentos"
ERROM[33] = "Argumento inv lido"
ERROM[34] = "Vari vel ou Procedure n„o Atribu¡da"
ERROM[35] = "Sele‡„o de Menu Inv lida"
ERROM[36] = ""
ERROM[37] = "Grupo de Express„o Muito Complexa"
ERROM[38] = ""
ERROM[39] = ""
ERROM[40] = "Mem¢ria Insuficiente para Concluir a Opera‡„o"
ERROM[41] = "Espa‡o em Disco Insuficiente para Concluir a Opera‡„o"
ERROM[42] = "Espa‡o na Pilha Insuficiente para Concluir a Opera‡„o"
ERROM[43] = "Impressora Fora de Linha ou Desligada"
ERROM[44] = "Aten‡„o! Sai do Sistema e Resete a M quina"
ERROM[45] = ""
ERROM[46] = ""
ERROM[47] = ""
ERROM[48] = ""
ERROM[49] = ""
ERROM[50] = "Registro eliminado pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]" 
ERROM[51] = "Registro alterado pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]"
ERROM[52] = "Registro inserido pelo usu rio "+Upper(ErrorUser())+" !// // ["+Upper(Tabela)+"]"
ERROM[53] = "Registro com Essa Chave J  Existente"
ERROM[54] = "Registro ou Tabela n„o estava Bloqueada"
ERROM[55] = "Registro J  Bloqueado por vocˆ"
ERROM[56] = "Chave de Pesquisa n„o Encontrada"
ERROM[57] = "Registro e Grupo Bloqueado Dependentendo do Bloqueio daquela Tabela"
ERROM[58] = ""
ERROM[59] = ""
ERROM[60] = "Verifica‡„o de Integridade Referencial"
ERROM[61] = "Formul rio MultiTabela Inv lido"
ERROM[62] = "Formul rio Bloqueado"
ERROM[63] = "V¡nculo Bloqueado"
ERROM[64] = "Grupo de Bloqueio Aplicado em Tabelas com Chaves Diferentes"
ERROM[65] = "Grupo de Registros Bloqueados"
ERROM[66] = "Esse Arquivo e Incompat¡vel com Essa Vers„o do PDOX"

DynArray Array_Mensagem[] 
TAMANHO  = 60
MENSAGEM = Rtrim("("+StrVal(Infoerro["CODE"])+") " + Infoerro["MESSAGE"])

ERRO_MSG = Completa("     Run: "+StrVal(Infoerro["LINE"])+"_"+StrVal(Infoerro["POSITION"])+"_"+Infoerro["SCRIPT"],TAMANHO+10," ")+"//"+
           Completa("    User: "+Infoerro["USER"],TAMANHO+10," ")+"//"

PosI = Int(Len(MENSAGEM)/TAMANHO)+1
For ii From 1 To PosI
  Switch
    Case ii=1 : CONTA_ARRAY = ii
    OtherWise : CONTA_ARRAY = (TAMANHO*(ii-1))+1
  EndSwitch
  If SubStr(MENSAGEM,CONTA_ARRAY,TAMANHO)<>""
     Then If ii=1
             Then ERRO_MSG = ERRO_MSG + Completa(" Message: "+SubStr(MENSAGEM,CONTA_ARRAY,TAMANHO),TAMANHO+10," ")+"//"
             Else ERRO_MSG = ERRO_MSG + Completa("          "+SubStr(MENSAGEM,CONTA_ARRAY,TAMANHO),TAMANHO+10," ")+"//"
          EndIf
     Else QuitLoop
  EndIf   
Endfor
ERRO_MSG = ERRO_MSG + Completa("    Proc: "+Infoerro["PROC"],TAMANHO+10," ")+"////"

Switch
  Case ErrorCode()=4:
       While True

         If Not IsAssigned(CONTADOR_BLOQUEIO_REGISTRO)
            Then CONTADOR_BLOQUEIO_REGISTRO=0
         EndIf

         If CONTADOR_BLOQUEIO_REGISTRO<3
            Then CONTADOR_BLOQUEIO_REGISTRO=CONTADOR_BLOQUEIO_REGISTRO+1
                 Sleep 3000
                 Valor=0
                 quitloop
         EndIf

         CONTADOR_BLOQUEIO_REGISTRO=0
         msgerro="("+StrVal(ErrorCode())+") "+ERROM[ErrorCode()]+"// //"+
                 Completa("- Este usu rio esta compartilhando os mesmos dados com vocˆ;",70," ")+"//"+
                 Completa("- Este bloqueio pode ser liberado a qualquer momento;",70," ")+"//"+
                 Completa("- Sempre prossiga com a rotina at‚ que seja liberado.",70," ")+"//"+
                 Completa("- Se necess rio verificar com o usu rio sobre o bloqueio;",70," ")+"// //"+
                          "Prosseguir com a rotina ?  (Fa‡a no m¡nimo 5 tentativas)"
         ConfGeral(ERRO_MSG+msgerro)
         If OK="N"
            Then msgerro="S¢ interrompa esta rotina se realmente//"
                 msgerro=msgerro+"for detectado que esta esteja travada !// //"
                 msgerro=msgerro+"Deseja realmente interrompe-la ?"
                 ConfGeral(ERRO_MSG+msgerro)
                 If OK="S"
                    Then 
                         Gravar_logerror(s)
                         
                         MSG=    "N„o esque‡a de liberar os conflitos dos arquivos [net] e [lck] !// //"
                         MSG=MSG+"- Executar reestrutura‡„o das tabelas,              //"
                         MSG=MSG+"- Executar reprocessamento do estoque, e caixa/banco//"
                         Do_It!
                         ClearAll
                         Play "\\Sistemas\\Cadastro\\InfoErro"
                         Exit
                    Else Loop
                 EndIf
            Else Valor=0
         EndIf
         QuitLoop
       EndWhile

  Case ErrorCode()=9 Or ErrorCode()=3 Or ErrorCode()=20:
       While True

         If Not IsAssigned(CONTADOR_BLOQUEIO_REGISTRO)
            Then CONTADOR_BLOQUEIO_REGISTRO=0
         EndIf

         If CONTADOR_BLOQUEIO_REGISTRO<3
            Then CONTADOR_BLOQUEIO_REGISTRO=CONTADOR_BLOQUEIO_REGISTRO+1
                 Sleep 3000
                 Valor=0
                 quitloop
         EndIf

         CONTADOR_BLOQUEIO_REGISTRO=0
         msgerro="("+StrVal(ErrorCode())+") "+ERROM[ErrorCode()]+"// //"+
                 Completa("- Este usu rio esta compartilhando os mesmos dados com vocˆ;",70," ")+"//"+
                 Completa("- Este bloqueio pode ser liberado a qualquer momento;",70," ")+"//"+
                 Completa("- Sempre prossiga com a rotina at‚ que seja liberado.",70," ")+"//"+
                 Completa("- Se necess rio verificar com o usu rio sobre o bloqueio;",70," ")+"// //"+
                          "Prosseguir com a rotina ?  (Fa‡a no m¡nimo 5 tentativas)"
         ConfGeral(ERRO_MSG+msgerro)
         If OK="N"
            Then msgerro="S¢ interrompa esta rotina se realmente//"
                 msgerro=msgerro+"for detectado que esta esteja travada !// //"
                 msgerro=msgerro+"Deseja realmente interrompe-la ?"
                 ConfGeral(ERRO_MSG+msgerro)
                 If OK="S"
                    Then 
                         Gravar_logerror(s)
                         
                         Mensagem("Liberar os conflitos dos arquivos [net] e [lck] !")
                         Do_It!
                         ClearAll
                         Play "\\Sistemas\\Cadastro\\InfoErro"
                         Exit
                    Else Loop
                 EndIf
            Else Valor=0
         EndIf
         QuitLoop
       EndWhile
  Case ErrorCode()=23:
       Gravar_logerror(s)
     
       TableInfo Table() Valchecks Field() To ArrayVal

       msgerro="("+StrVal(ErrorCode())+") "+ERROM[ErrorCode()]+" !// //"
       msgerro=msgerro+"[F1] Campo recebendo valor que n„o existe no cadastro !// //"
       msgerro=msgerro+Completa("    Tabela: [ "+Table()           +" ]",60," ")+"//"
       msgerro=msgerro+Completa("     Campo: [ "+Field()           +" ]",60," ")+"//"
       msgerro=msgerro+Completa("Lookup com: [ "+ArrayVal["LOOKUP"]+" ]",60," ")+"// //"
       msgerro=msgerro+"Verificar dados de cadastro !"
       Mensagem(msgerro)

      ;Switch
      ;  Case SubStr(FieldType(),1,1)="A": Execute "["+ncerr+"]=\"\""
      ;  Case FieldType()="N" or
      ;       FieldType()="S" or
      ;       FieldType()="$"            : Execute "["+ncerr+"]=BlankNum()"
      ;  Case FieldType()="D"            : Execute "["+ncerr+"]=BlankDate()"
      ;EndSwitch
       Valor=1
       
       
  OtherWise:
       msgerro="("+StrVal(ErrorCode())+") "+ERROM[ErrorCode()]+"// //"+
               "Verificar o erro, e tente prosseguir a execu‡„o.//"+
               "Se persistir o erro, n„o prossiga Ok !// //"+
               "Continua a execu‡„o deste programa ?"
       ConfGeral(ERRO_MSG+msgerro)
       If OK="N"
          Then 
               Gravar_logerror(s)
               
               Do_It!
               ClearAll
               Play "\\Sistemas\\Cadastro\\InfoErro"
               Exit
          Else Valor=0
       EndIf
EndSwitch

Release Vars ERROM,OK,Opcaoc,msgerro,ArrayVal,valorc

Return Valor
EndProc

;*******************************************************************************
;* gravar Erros                                                                *
;*******************************************************************************
Proc Gravar_logerror(s)
private arqtxt,LOG_MES,LOG_ANO,TXT_MES,TXT_ANO

;**** LOGError.TXT ***************************************************************
LOG_MES = Month(Today())
LOG_ANO = Year(Today())
TXT_MES = Ltrim(StrVal(LOG_MES))                                   If Len(TXT_MES)=1 Then TXT_MES = AlinhM(TXT_MES,2) EndIf 
TXT_ANO = SubStr(StrVal(LOG_ANO),3,2) 
arqtxt  = SubStr(Directory(),1,2)+"\\Sistemas\\Cadastro\\lger"+TXT_MES+TXT_ANO+".log"

If Isfile(arqtxt)
   Then FileWrite Append arqtxt From s+"\n"
   Else FileWrite        arqtxt From s+"\n"
EndIf

release vars arqtxt,s
EndProc

;*******************************************************************************
;* MONTA JANELA PARA CONFIGURAR DISPOSITIVO VIDEO,IMPRESSORA,ARQUIVO           *
;*******************************************************************************
Proc Dispositivo()
LimpAguarde()

Mouse Show

Sys_Set_Video           = "01C  Padr„o    80x25"
Sys_ReSet_Video         = "01C  Padr„o    80x25"
Sys_Visualiza_Grafico   = "WIN"
Sys_Visualiza_Relatorio = "WIN"

Ler_Captura(PrivDir()+"Cfg_Imp")
Op_Disp  = True
Op_DispG = False
Op_DispI = False

DIREPORT    = PrivDir()
ARQUIVO     = ""
OPCAOPAGINI = BlankNum()
OPCAOPAGFIM = BlankNum()
NUMCOPIA    = 1
PDFZEBRA    = False

Dispositivo=1
Paginas    =1

Sound 700 5
While True
                                
  ShowDialog "Selecionar Destino" Proc "SD_Dispositivo"
   Trigger "OPEN","ARRIVE","SELECT","CLOSE"
     Key "TAB","ReverseTab","ENTER","ESC",-31,-16,32,-18,-63
      @ 02,10 Height 20 Width 78

    Frame Single From 00,00 to 05,23
    @ 00,01 ?? " Dispositivo "
    RadioButtons @ 01,01 Height 4 Width 18
      "~V~¡deo",
      "V¡deo/~Z~ebrado",
      "~I~mpressora",
      "~A~rquivo"
      Tag "Dispositivo"
      To Dispositivo

    Frame Single From 06,00 to 11,23
    @ 06,01 ?? " Intervalo de p ginas "
    RadioButtons @ 07,01 Height 2 Width 17
      "~T~odas",
      "S~e~lecionar"
      Tag "Paginas"
      To Paginas

    Label @ 10,01 "da" For "PaginaI"
    Accept @ 10,05 Width 6 "S" Tag "PaginaI" to OPCAOPAGINI
    Label @ 10,11 "at‚" For "PaginaF"
    Accept @ 10,16 Width 6 "S" Tag "PaginaF" to OPCAOPAGFIM
    
    Frame Single From 12,00 to 14,23
    @ 12,01 ?? " C¢pias "
    Label  @ 13,01 "~N~§ C¢pias" For "NCopia"
    Accept @ 13,12 Width 5 "S" Tag "NCopia" to NUMCOPIA
    
    Frame Single From 00,24 to 17,75
    Label  @ 00,25 "~S~aidas para Impressoras" For "TG_IMPOPCOES"
    PickDynArray @01,25 Height 16 width 49
     Columns 1
      SYS_ARRAY_IMPOPCOES
       Tag "TG_IMPOPCOES"
        To VSDGIMPOPCAO

    Pushbutton @ 16,00 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue  ;34
    Pushbutton @ 16,13 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue  ;52

  EndDialog

  If Not RetVal
     Then OK=""
          QuitLoop
  EndIf
  
  If Checa_Dispositivo("")
     Then Mudou=False
          For i from 1 to DynArraySize(SYS_ARRAY_IMPOPCOES)
              If (i=1) or (i=2) or (i=3)
                 Then If (SubStr(SYS_ARRAY_IMPOPCOES[i],2,1)="") And
                         (SYS_SET_PORTA<>SubStr(SYS_ARRAY_IMPOPCOES[i],3,4))
                         Then Mudou=True
                      EndIf
                      Loop
              EndIf

              If (SubStr(SYS_ARRAY_IMPOPCOES[i],2,1)="") And
                 (SYS_SET_PORTA<>SubStr(SYS_ARRAY_IMPOPCOES[i],3,100))
                 Then Mudou=True
              EndIf
          EndFor

          If Mudou=true Then
             FileWrite        PrivDir()+"Cfg_Imp.sc" From ";****** Variaveis de Configura‡„o de Impressora Vise Informatica"+"\n"
             For i From 1 to DynArraySize(SYS_ARRAY_IMPOPCOES)
               If SubStr(SYS_ARRAY_IMPOPCOES[i],2,1)=""
                  Then Switch
                         Case i=1 Or i=2 Or i=3:
                              FileWrite Append PrivDir()+"Cfg_Imp.sc" From "Sys_Set_Porta  =\""+SubStr(SYS_ARRAY_IMPOPCOES[i],3,4)+"\""+"\n"
                         OtherWise:
                              If SubStr(SYS_ARRAY_IMPOPCOES[i],3,1)="\\"
                                 Then Caminho=""
                                      For j from 3 to len(SYS_ARRAY_IMPOPCOES[i])
                                         If SubStr(SYS_ARRAY_IMPOPCOES[i],j,1)="\\"
                                            Then Caminho=Caminho+"\\"
                                         EndIf
                                         Caminho=Caminho+SubStr(SYS_ARRAY_IMPOPCOES[i],j,1)
                                      EndFor
                                      FileWrite Append PrivDir()+"Cfg_Imp.sc" From "Sys_Set_Porta  =\""+RTrim(SubStr(Caminho,1,100))+"\""+"\n"
                                 Else FileWrite Append PrivDir()+"Cfg_Imp.sc" From "Sys_Set_Porta  =\""+RTrim(SubStr(SYS_ARRAY_IMPOPCOES[i],3,100))+"\""+"\n"
                              EndIf
                       EndSwitch
               EndIf
             EndFor
          EndIf
          QuitLoop
  EndIf

EndWhile
Style Attribute 31
Release Vars Op_Disp,Op_DispG,Op_DispI
EndProc

;*******************************************************************************
;* MONTA JANELA PARA CONFIGURAR DISPOSITIVO VIDEO,IMPRESSORA                   *
;*******************************************************************************
Proc DispositivoI(ModProgram)
Private ModProgram

If Not IsAssigned(SYS_APLICATIVO) then SYS_APLICATIVO="" endif

Mouse Show

LimpAguarde()
Ler_Captura(PrivDir()+ModProgram+"_Imp")

OPCAOPAGINI = BlankNum()
OPCAOPAGFIM = BlankNum()
OPCAOPAG    = "Todas"
PDFZEBRA    = False

Op_Disp     = False
Op_DispG    = False
Op_DispI    = True

If Not IsAssigned(Dispositivo) Then Dispositivo=3 EndIf

If Not IsAssigned(NUMCOPIA)
   Then NUMCOPIA=1
EndIf

Array TG_OPEMAIL[1]
TG_OPEMAIL[1]="+ ~E~-mail"

Array CheckTG_OPEMAIL[ArraySize(TG_OPEMAIL)]
CheckTG_OPEMAIL[1]=False
If SYS_APLICATIVO="FATURA" Or SYS_APLICATIVO="BALCAO"
   Then If SYS_CODIGO_CLIENTE = "0359" Or 
           SYS_CODIGO_CLIENTE = "0370" Or
           SYS_CODIGO_CLIENTE = "0278" Or
           ;SYS_CODIGO_CLIENTE = "0343" Or
           SYS_CODIGO_CLIENTE = "0392" Or
           SYS_CODIGO_CLIENTE = "0380" Or
           SYS_CODIGO_CLIENTE = "0431" Or
           SYS_CODIGO_CLIENTE = "0232"
           Then CheckTG_OPEMAIL[1]=True
        EndIf    
EndIf

If SYS_APLICATIVO="PEDIDO" 
   Then If SYS_CODIGO_CLIENTE = "0222" Or
           SYS_CODIGO_CLIENTE = "0227" Or
           SYS_CODIGO_CLIENTE = "0232"
           Then CheckTG_OPEMAIL[1]=True
        EndIf    
EndIf

If SYS_APLICATIVO="TROCA" 
   Then If SYS_CODIGO_CLIENTE = "0278"
           Then CheckTG_OPEMAIL[1]=True
        EndIf    
EndIf

If Not IsAssigned(MSGDISPOSITIVO) Or MSGDISPOSITIVO="" 
   Then MSGDISPOSITIVO="Selecionar Destino"
EndIf

Sound 700 5
While True

  ShowDialog MSGDISPOSITIVO Proc "SD_Dispositivo"
   Trigger "OPEN","ARRIVE","SELECT","CLOSE"
     Key "TAB","ReverseTab","ENTER","ESC",-31,-16,32,-18,-63
      @ 02,10 Height 20 Width 78
                
    Frame Single From 00,00 to 06,23
    @ 00,01 ?? " Dispositivo "
    RadioButtons @ 01,01 Height 3 Width 18
      "~V~¡deo",
      "V¡deo/~Z~ebrado",
      "~I~mpressora"
      Tag "Dispositivo"
      To Dispositivo
      
    CheckBoxes @ 05,01 Height 1 Width 15 Tag "TG_OPEMAIL"
    TG_OPEMAIL[1] to CheckTG_OPEMAIL[1]

    Frame Single From 07,00 to 09,23
    @ 07,01 ?? " C¢pias "
    Label  @ 08,02 "~N~§ C¢pias" For "NCopia"
    Accept @ 08,13 Width 5 "S" Tag "NCopia" to NUMCOPIA

    
    Frame Single From 00,24 to 17,75
    Label  @ 00,24 "~S~aidas para Impressoras" For "TG_IMPOPCOES"
    PickDynArray @01,25 Height 16 width 49
     Columns 1
      SYS_ARRAY_IMPOPCOES
       Tag "TG_IMPOPCOES"
        To VSDGIMPOPCAO

    Pushbutton @ 16,00 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue ;22
    Pushbutton @ 16,13 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue ;40

  EndDialog

  If Not RetVal
     Then OK=""
          QuitLoop
  EndIf

  If Checa_Dispositivo("DISPOSITIVOI") Then
     If OK="I" Or OK="V" Then
        FileWrite PrivDir()+ModProgram+"_Imp.sc" From  ";****** Variaveis de Configura‡„o de Impressora Vise Informatica"+"\n"
        Switch
          Case VSDGIMPOPCAO="1" Or VSDGIMPOPCAO="2" Or VSDGIMPOPCAO="3":
               FileWrite Append PrivDir()+ModProgram+"_Imp.sc" From  "Sys_Set_Porta  =\""+SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4)+"\""+"\n"
          OtherWise:
               If SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,1)="\\"
                  Then Caminho=""
                       For j from 3 to len(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO])
                          If SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],j,1)="\\"
                             Then Caminho=Caminho+"\\"
                          EndIf
                          Caminho=Caminho+SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],j,1)
                       EndFor
                       FileWrite Append PrivDir()+ModProgram+"_Imp.sc" From  "Sys_Set_Porta  =\""+RTrim(SubStr(Caminho,1,100))+"\""+"\n"
                  Else FileWrite Append PrivDir()+ModProgram+"_Imp.sc" From  "Sys_Set_Porta  =\""+RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,100))+"\""+"\n"
               EndIf
        EndSwitch
        FileWrite Append PrivDir()+ModProgram+"_Imp.sc" From "Dispositivo="+StrVal(Dispositivo)
     EndIf
     QuitLoop
   EndIf
EndWhile
Style Attribute 31
Release Vars Op_Disp,Op_DispG,Op_DispI

EndProc ;DispositivoI()

;*******************************************************************************
;* MONTA JANELA PARA CONFIGURAR DISPOSITIVO VIDEO,IMPRESSORA                   *
;*******************************************************************************
Proc DispositivoEtq()
Private Nome_Arquivo

LimpAguarde()
Mouse Show

LimpAguarde()

OPCAOPAGINI = BlankNum()
OPCAOPAGFIM = BlankNum()
OPCAOPAG    = "Todas"
PDFZEBRA    = False
Op_Disp     = False
Op_DispG    = False
Op_DispI    = True         

Sys_Set_Video           = "01C  Padr„o    80x25"
Sys_ReSet_Video         = "01C  Padr„o    80x25"
Sys_Visualiza_Grafico   = "WIN"
Sys_Visualiza_Relatorio = "WIN"

Dispositivo = 3
DIREPORT    = PrivDir()
ARQUIVO     = ""                  

Ler_Captura(PrivDir()+"ETQ_Imp") 
NUMCOPIA = 1

If Not IsAssigned(MSGDISPOSITIVO) Or MSGDISPOSITIVO="" 
   Then MSGDISPOSITIVO="Selecionar Destino"
EndIf

Sound 700 5
While True
  PARAM_ETIQUETA=True
  ShowDialog MSGDISPOSITIVO Proc "SD_Dispositivo"
   Trigger "OPEN","ARRIVE","SELECT","CLOSE"
     Key "TAB","ReverseTab","ENTER","ESC",-31,-16,32,-18,-63
      @ 02,10 Height 20 Width 78
      
    Frame Single From 00,00 to 05,23
    @ 00,01 ?? " Dispositivo "
    RadioButtons @ 01,01 Height 3 Width 18
      "~V~¡deo",
      "V¡deo/~Z~ebrado",
       "~I~mpressora"
      Tag "Dispositivo"
      To Dispositivo
      
    Frame Single From 00,24 to 17,75
    Label  @ 00,25 "~S~aidas para Impressoras" For "TG_IMPOPCOES"
    PickDynArray @01,25 Height 16 width 49
    Columns 1
     SYS_ARRAY_IMPOPCOES
      Tag "TG_IMPOPCOES"
       To VSDGIMPOPCAO

    Pushbutton @ 16,00 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue  ;22
    Pushbutton @ 16,13 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue  ;40
  EndDialog

  If Not RetVal
     Then OK=""
          QuitLoop
  EndIf
  If Checa_Dispositivo("DISPOSITIVOI") Then
     If OK="I" Or OK="V" Then
        FileWrite        PrivDir()+"ETQ_IMP.sc" From  ";****** Variaveis de Configura‡„o de Impressora Vise Informatica"+"\n"
        Switch
          Case VSDGIMPOPCAO="1" Or VSDGIMPOPCAO="2" Or VSDGIMPOPCAO="3":
               FileWrite Append PrivDir()+"ETQ_IMP.sc" From  "Sys_Set_Porta  =\""+SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4)+"\""+"\n"
          OtherWise:
               If SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,1)="\\"
                  Then Caminho=""
                       For j from 3 to len(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO])
                        If SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],j,1)="\\"
                            Then Caminho=Caminho+"\\"
                          EndIf
                          Caminho=Caminho+SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],j,1)
                       EndFor
                       FileWrite Append PrivDir()+"ETQ_IMP.sc" From  "Sys_Set_Porta  =\""+RTrim(SubStr(Caminho,1,100))+"\""+"\n"
                  Else FileWrite Append PrivDir()+"ETQ_IMP.sc" From  "Sys_Set_Porta  =\""+RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,100))+"\""+"\n"
               EndIf
        EndSwitch
     EndIf
     QuitLoop
  EndIf 
EndWhile
Style Attribute 31
Release Vars Op_Disp,Op_DispG,Op_DispI,PARAM_ETIQUETA  

EndProc ;DispositivoEtq()

;*******************************************************************************
;* MONTA JANELA PARA CONFIGURAR DISPOSITIVO VIDEO,IMPRESSORA,ARQUIVO           *
;*******************************************************************************
Proc DispositivoG()
LimpAguarde()

Mouse Show

Sys_Set_Video           = "01C  Padr„o    80x25"
Sys_ReSet_Video         = "01C  Padr„o    80x25"
Sys_Visualiza_Grafico   = "WIN"
Sys_Visualiza_Relatorio = "WIN"

If Sys_Visualiza_Grafico="WIN"
   Then OK="V"
        Return
EndIf

Ler_Captura(PrivDir()+"Cfg_Imp")

OPCAOPAGINI = BlankNum()
OPCAOPAGFIM = BlankNum()
OPCAOPAG    = "Todas"
Dispositivo = 1
Op_Disp     = False
Op_DispG    = True
Op_DispI    = False

OPCAOE     = ""
NUMCOPIA   = 1

Sound 700 5
While True

  ShowDialog "Selecionar Destino" Proc "SD_Dispositivo"
   Trigger "OPEN","ARRIVE","SELECT","CLOSE"
     Key "TAB","ReverseTab","ENTER","ESC",-31,-16,32,-18,-63
      @ 02,10 Height 20 Width 78

    Frame Single From 00,00 to 05,23
    @ 00,01 ?? " Dispositivo "
    RadioButtons @ 01,01 Height 2 Width 18
      "~V~¡deo",
      "~I~mpressora"
      Tag "Dispositivo"
      To Dispositivo

    Frame Single From 06,00 to 08,23
    @ 06,01 ?? " C¢pias "
    Label  @ 07,02 "~N~§ C¢pias" For "NCopia"
    Accept @ 07,13 Width 5 "S" Tag "NCopia" to NUMCOPIA

    Frame Single From 00,24 to 17,75
    Label  @ 00,25 "~S~aidas para Impressoras" For "TG_IMPOPCOES"
    PickDynArray @01,25 Height 16 width 49
     Columns 1
      SYS_ARRAY_IMPOPCOES
       Tag "TG_IMPOPCOES"
        To VSDGIMPOPCAO

    Pushbutton @ 16,00 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue ;22
    Pushbutton @ 16,13 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue ;40

  EndDialog

  If Not RetVal
     Then OK=""
          QuitLoop
  EndIf
  
  If Checa_Dispositivo("")
     Then QuitLoop
  EndIf
  
EndWhile
Style Attribute 31
Release Vars Op_Disp,Op_DispG,Op_DispI

EndProc ;DispositivoG()

;*******************************************************************************
;* ROTINA CHECAR DISPOSITIVO VIDEO,IMPRESSORA,ARQUIVO                          *
;*******************************************************************************
Proc Checa_Dispositivo(Origem)
Private ChecagemOk, Origem
ChecagemOk=True

If Not IsAssigned(Sys_Visualiza_Relatorio) Then Sys_Visualiza_Relatorio="WIN" EndIf

switch
  case Op_Disp =True And Dispositivo=2 : PDFZEBRA=True
  case Op_DispI=True And Dispositivo=2 : PDFZEBRA=True
  otherwise                            : PDFZEBRA=False
endswitch

While True
  If NUMCOPIA<1
     Then Campo_Disp="NCopia"
          Mensagem("Numero de copias invalida !")
          ChecagemOk=False
          QuitLoop
  EndIf
  If Op_Disp=True And Paginas = 2
     Then If OPCAOPAGINI<1
             Then Campo_Disp="PaginaI"
                  Mensagem("Pagina inicial invalida !")
                  ChecagemOk=False
                  QuitLoop
             Else If OPCAOPAGFIM<OPCAOPAGINI
                     Then Campo_Disp="PaginaF"
                          Mensagem("Pagina final invalida !")
                          ChecagemOk=False
                          QuitLoop
                  EndIf
          EndIf
  EndIf
  Switch
    Case (Op_Disp  =True And Dispositivo=4):
          Play "\\Sistemas\\Cadastro\\GravArq"
          If IsBlank(ARQUIVO)
             Then Campo_Disp="Dispositivo"
                  ChecagemOk=False
                  QuitLoop
          EndIf
          
    Case (Op_Disp  =True And Dispositivo=3) Or
         (Op_DispG =True And Dispositivo=2) Or
         (Op_DispI =True And Dispositivo=3):
         If VSDGIMPOPCAO="1" Or
            VSDGIMPOPCAO="2" Or
            VSDGIMPOPCAO="3"
            Then If IsBlank(RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],10,10)))
                    Then MSG="Impressora sem tipo definido !// //"+
                             "Matricial, Jato Tinta, Laser... // //"+
                             "Configurar impressora ! (* Utilit rios)"
                         Mensagem(MSG)
                         ChecagemOk=False
                         LimpAguarde()
                         QuitLoop
                 EndIf
                 Switch
                   Case VSDGIMPOPCAO="1": SETA_PRINTER="LPT1"
                   Case VSDGIMPOPCAO="2": SETA_PRINTER="LPT2"
                   Case VSDGIMPOPCAO="3": SETA_PRINTER="LPT3"
                 EndSwitch

                 If Origem<>"DISPOSITIVOI"
                    Then SetPrinter SETA_PRINTER
                 EndIf

                 Aguarde("Aguarde, Checando impressora")
                 
                 ;If PrinterStatus()=False
                 ;   Then MSG="Impressora n„o esta Pronta !// //"+
                 ;            "Verificar se a mesma n„o esta://"+
                 ;            "Fora de Linha, Desligada, Sem Papel,//"+
                 ;            "Desconectada ou n„o Instalada !"
                 ;        Mensagem(MSG)
                 ;        ChecagemOk=False
                 ;        LimpAguarde()
                 ;        QuitLoop
                 ;EndIf        
                 Seta_Tipo_Impressora(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],09,10))
                 LimpAguarde()
            Else If Substr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],5,3)="---" Or
                    Substr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],1,1)="X"            
                    Then return False
                 EndIf

                 If Op_DispG =True
                    Then If (Sys_Visualiza_Relatorio="DOS" And Dispositivo=2)
                            Then ChecagemOK=False
                                 Mensagem("Apenas dispoin¡vel LPT1, LPT2 e LPT3 !")
                                 QuitLoop
                         EndIf
                 EndIf
                 Seta_Tipo_Impressora("Matricial")
                 SETA_PRINTER=RTrim(SuBstr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,Len(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO])))

         EndIf

  EndSwitch

  Switch
    Case Op_Disp  =True:
         If Dispositivo=1 Then DISPOSITIVO_OPCAO="V" EndIf
         If Dispositivo=2 Then DISPOSITIVO_OPCAO="V" EndIf
         If Dispositivo=3 Then DISPOSITIVO_OPCAO="I" EndIf
         If Dispositivo=4 Then DISPOSITIVO_OPCAO="A" EndIf
         
         If Paginas=1
            Then OPCAOPAG="Todas"
            Else OPCAOPAG="Selecionar"
         EndIf
         
    Case Op_DispI =True:
         If Dispositivo=1 Then DISPOSITIVO_OPCAO="V" EndIf
         If Dispositivo=2 Then DISPOSITIVO_OPCAO="V" EndIf
         If Dispositivo=3 Then DISPOSITIVO_OPCAO="I" EndIf

    Case Op_DispG =True:
         If Dispositivo=1 Then DISPOSITIVO_OPCAO="V" EndIf
         If Dispositivo=2 Then DISPOSITIVO_OPCAO="I" EndIf
         Impressao_Orientacao="Retrato"
         Switch
           Case RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],10,10))="Matricial"  : OPCAOE="Matricial"
           Case RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],10,10))="Jato Tinta" : OPCAOE="Jato de Tinta"
         EndSwitch

  EndSwitch
  OK=DISPOSITIVO_OPCAO

  If OK="I"
     Then If VSDGIMPOPCAO="1" Or
             VSDGIMPOPCAO="2" Or
             VSDGIMPOPCAO="3" ;LPT1, LPT2, LPT3
             Then For c From 1 to 7
                   If Not IsFile(PrivDir()+"Captura.txt")
                      Then Sleep 1000
                           Loop
                      Else Editor Open PrivDir()+"Captura.Txt"
                           If ErrorCode()=27
                              Then Sleep 1000
                                   Loop
                           EndIf

                           {Edit} {Goto} {1}
                           Editor Find SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4)
                           If RetVal
                              Then Extrair_Linha()
                                   posini2 =search("\\",ELinha)
                                   caminho2=LTrim(RTrim(SubStr(ELinha,posini2,26)))
                                   posini2=search(Chr(10),caminho2)
                                   If posini2>0
                                      Then caminho2=SubStr(caminho2,1,(posini2-1))
                                   EndIf

                                   caminho=LTrim(RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],20,60)))

                                   Simbolo=" ?"
                                   If Upper(caminho2)=Upper(caminho)
                                      Then If Upper(LTrim(SubStr(ELinha,1,02)))="OK"
                                              Then Simbolo=" !"
                                           EndIf
                                      Else Finaliza_Captura(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4) )
                                           Executa_Captura(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4) +" "+Caminho)
                                           MSG=Checa_Captura(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4) ,Caminho)
                                           If Not Checou_Impressora
                                              Then Mensagem(MSG)
                                                   ChecagemOk=False
                                           EndIf
                                   EndIf

                                   SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO]=SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],1,19)+
                                                          Caminho+Simbolo
                                   SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO]=Completa(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],77," ")+"*"
                              Else caminho=LTrim(RTrim(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],20,60)))
                                   If Caminho <> "Local"
                                      Then Executa_Captura(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4) +" "+Caminho)
                                           MSG=Checa_Captura(SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,4) ,Caminho)
                                           If Not Checou_Impressora
                                              Then Mensagem(MSG)
                                                   ChecagemOk=False
                                           EndIf
                                   EndIf
                           EndIf
                           CancelEdit
                           QuitLoop
                   EndIf
                  EndFor
          EndIf
  EndIf

  If OK="V"
     Then Seta_Tipo_Impressora("Matricial")
  EndIf   

  If Ok="V" and Sys_Visualiza_Relatorio="WIN"
     Then If Not IsFile("C:\\vise\\xexe.exe")
             Then Mensagem("ExecVise nÆo instalado !")
                  ChecagemOk=False
          EndIf

          If IsFile("c:\\vise\\Vdpr.exe")
             Then
             Else Mensagem("DosPrinter nÆo instalado !")
                  ChecagemOk=False
          EndIf
  EndIf
  If Ok="V" and Sys_Visualiza_Relatorio="DOS" And Op_DispI =True
     Then Mensagem("Visualiza‡„o permitida somente com Windows/Adobe PDF !//Verificar Utilit rios/V¡deo")
          ChecagemOk=False
  EndIf

  QuitLoop
EndWhile

Return ChecagemOk
EndProc

;*******************************************************************************
;* ROTINA CONFIGURAR DISPOSITIVO VIDEO,IMPRESSORA,ARQUIVO                      *
;*******************************************************************************
Proc SD_Dispositivo(Disparo_Disp,Campo_Disp,Evento_Disp,Elemento_Disp)
private Disparo_Disp,Campo_Disp,Evento_Disp,Elemento_Disp

If Not IsAssigned(PARAM_ETIQUETA) Then PARAM_ETIQUETA=False EndIf
Temp     =True
MSG_CAMPO=""
TECLA    =""

If Disparo_Disp="OPEN"  
   Then AoCriarShowDialog()
EndIf

If Disparo_Disp="CLOSE"  
   Then MSG_CAMPO="."
EndIf

If (Disparo_Disp="ARRIVE" Or Disparo_Disp="SELECT") And Campo_Disp="TG_IMPOPCOES"
   Then Switch
          Case Op_Disp =True : Dispositivo=3
          Case Op_DispG=True : Dispositivo=2
          Case Op_DispI=True : Dispositivo=3
        EndSwitch
EndIf

If Disparo_Disp="EVENT" And Evento_Disp["Type"]="KEY" Then
   Switch
     Case Evento_Disp["KeyCode"] = -15:
          Temp=False

     Case Evento_Disp["KeyCode"] = 9:
          Temp=False

          Switch
            Case Op_Disp  =True:
                 Switch
                   Case Campo_Disp="Dispositivo":
                     If Dispositivo=4 Or PARAM_ETIQUETA
                        Then Campo_Disp="YES"
                        Else Campo_Disp="Paginas"
                     EndIf
                   Case Campo_Disp="Paginas"    :
                        If Paginas=1
                           Then If Dispositivo = 1 Or
                                   Dispositivo = 2 Or
                                   Dispositivo = 4    
                                   Then NumCopia=1
                                        Campo_Disp="YES"
                                   Else If Not PARAM_ETIQUETA
                                           Then Campo_Disp="NCopia"
                                        EndIf   
                                EndIf
                           Else Campo_Disp="PaginaI"
                        EndIf
                   Case Campo_Disp="PaginaI"    : Campo_Disp="PaginaF"
                        OPCAOPAGINI =ControlValue("PaginaI")
                   Case Campo_Disp="PaginaF"    :
                        OPCAOPAGFIM =ControlValue("PaginaF")
                        If Dispositivo=1 Or
                           Dispositivo=2 Or
                           Dispositivo=4
                           Then NumCopia=1
                                Campo_Disp="YES"
                           Else If Not PARAM_ETIQUETA
                                   Then Campo_Disp="NCopia"
                                EnDIf   
                        EndIf
                   Case Campo_Disp="NCopia"       : Campo_Disp="TG_IMPOPCOES"
                        NUMCOPIA    =ControlValue("NCopia")
                   Case Campo_Disp="TG_IMPOPCOES" : Campo_Disp="YES"

                   Case Campo_Disp="YES"          : Campo_Disp="NO"
                   Case Campo_Disp="NO"           : Campo_Disp="Dispositivo"
                 EndSwitch

            Case Op_DispG =True:
                 Switch
                   Case Campo_Disp="Dispositivo":
                     If Dispositivo=2
                        Then Campo_Disp="TG_IMPOPCOES"
                        Else Campo_Disp="YES"
                     EndIf
                   Case Campo_Disp="TG_IMPOPCOES" : 
                        If Dispositivo = 2
                           Then Campo_Disp="TG_OPEMAIL"
                           Else If Not PARAM_ETIQUETA
                                   Then Campo_Disp="NCopia"
                                EndIf
                        EndIf  
                   Case Campo_Disp="TG_OPEMAIL"    : Campo_Disp="NCopia"
                   Case Campo_Disp="NCopia"       : Campo_Disp="YES"
                        NUMCOPIA    =ControlValue("NCopia")
                   Case Campo_Disp="YES"          : Campo_Disp="NO"
                   Case Campo_Disp="NO"           : Campo_Disp="Dispositivo"
                 EndSwitch

            Case Op_DispI =True:
                 Switch
                   Case Campo_Disp="Dispositivo":
                     If Dispositivo=3
                        Then Campo_Disp="TG_IMPOPCOES"
                        Else Campo_Disp="TG_OPEMAIL"
                     EndIf
                   Case Campo_Disp="TG_IMPOPCOES" : Campo_Disp="TG_OPEMAIL"
                   Case Campo_Disp="TG_OPEMAIL"   : Campo_Disp="NCopia"
                   Case Campo_Disp="NCopia"       : Campo_Disp="YES"
                        NUMCOPIA    =ControlValue("NCopia")
                   Case Campo_Disp="YES"          : Campo_Disp="NO"
                   Case Campo_Disp="NO"           : Campo_Disp="Dispositivo"
                 EndSwitch

          EndSwitch

     Case Evento_Disp["KeyCode"] = -31: Campo_Disp="TG_IMPOPCOES"
          Switch
            Case Op_Disp =True : Dispositivo=3
            Case Op_DispG=True : Dispositivo=2
            Case Op_DispI=True : Dispositivo=3
          EndSwitch

     Case Evento_Disp["KeyCode"] = -49: If Not PARAM_ETIQUETA
                                           Then Campo_Disp="NCopia"
                                        EnDIf 
     Case Evento_Disp["KeyCode"] = 27:
          Temp=False

          CancelDialog

     Case Evento_Disp["KeyCode"] = 32 and Campo_Disp="TG_IMPOPCOES":
          Switch
            Case SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],5,3)="---" Or
                 Substr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],1,1)="X"    :

            Case SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],2,1)="":
                 SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO]= SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],1,1)+" "+
                                                    SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,100)
            OtherWise:
                 IMP_SEL=SubStr(SYS_ARRAY_IMPOPCOES[VSDGIMPOPCAO],3,100)

                 For i from 1 to DynArraySize(SYS_ARRAY_IMPOPCOES)
                     If SubStr(SYS_ARRAY_IMPOPCOES[i],2,1)=""
                        Then SYS_ARRAY_IMPOPCOES[i]= SubStr(SYS_ARRAY_IMPOPCOES[i],1,1)+" "+
                                                     SubStr(SYS_ARRAY_IMPOPCOES[i],3,100)
                             QuitLoop
                     EndIf
                 EndFor

                 For i from 1 to DynArraySize(SYS_ARRAY_IMPOPCOES)
                     If SubStr(SYS_ARRAY_IMPOPCOES[i],3,100)=IMP_SEL
                        Then SYS_ARRAY_IMPOPCOES[i]= SubStr(SYS_ARRAY_IMPOPCOES[i],1,1)+""+
                                                     SubStr(SYS_ARRAY_IMPOPCOES[i],3,100)
                     EndIf
                 EndFor
          EndSwitch

     Case Evento_Disp["KeyCode"] = -63:
          Aguarde("Atualizando Impressoras")
          Ler_Captura("")

     Case Evento_Disp["KeyCode"] = 13:
          Temp=False
          Switch
            Case Campo_Disp="NO":
                 
                 CancelDialog
            OtherWise:
                 Switch
                   Case Op_Disp  =True:
                        If Not PARAM_ETIQUETA
                           Then OPCAOPAGINI =ControlValue("PaginaI")
                                OPCAOPAGFIM =ControlValue("PaginaF")
                                NUMCOPIA    =ControlValue("NCopia")
                        EnDIf           
                   Case Op_DispG =True Or
                        Op_DispI =True:
                        If Not PARAM_ETIQUETA
                           Then NUMCOPIA    =ControlValue("NCopia")
                        EndIf   
                 EndSwitch
                 AcceptDialog
          EndSwitch
   EndSwitch
EndIf
Monta_Prompt_Disp(MSG_CAMPO,TECLA)

Return Temp
EndProc

;*******************************************************************************
;* Rotina para montar Prompt/Message ShowDialog-Dispositivo                    *
;*******************************************************************************
Proc Monta_Prompt_Disp(msg,key)
Private msg

MSG_CAMPO=msg
TECLA=key
SelectControl Campo_Disp

if MSG_CAMPO="."
   then LimpaRodape(0)
        RefreshDialog
        return
endif   

If MSG_CAMPO=""
   Then Switch
          Case Campo_Disp="Dispositivo":
               MSG_CAMPO="Selecione o dispositivo de saida !"
          Case Campo_Disp="TG_IMPOPCOES":
               MSG_CAMPO="Selecione a porta de saida !"
          Case Campo_Disp="Tipo":
               MSG_CAMPO="Selecione o tipo da impressora !"
          Case Campo_Disp="Paginas":
               MSG_CAMPO="Selecione a op‡„o de p ginas !"
          Case Campo_Disp="PaginaI":
               MSG_CAMPO="Informe o numero da pagina inicial !"
          Case Campo_Disp="PaginaF":
               MSG_CAMPO="Informe o numero da pagina final !"
          Case Campo_Disp="NArquivo":
               MSG_CAMPO="Informe o nome do arquivo a gravar !"
          Case Campo_Disp="NCopia":
               MSG_CAMPO="Informe o numero de copias a imprimir !"
          Case Campo_Disp="YES" Or Campo_Disp="ARQ_YES":
               MSG_CAMPO="[Enter]=Confirmar Dados/Executar !"
          Case Campo_Disp="NO"  Or Campo_Disp="ARQ_NO":
               MSG_CAMPO="[Enter]=Cancelar/Voltar !"
          Case Campo_Disp="TG_ARQUIVOS":
               MSG_CAMPO="Selecione o arquivo se desejar !"
        EndSwitch
EndIf
If TECLA=""
   Then Switch
          Case Campo_Disp="Dispositivo" Or
               Campo_Disp="Tipo"        Or
               Campo_Disp="Paginas":
               TECLA="=Selecionar  "
          Case Campo_Disp="TG_IMPOPCOES":
               TECLA=Chr(25)+Chr(24)+"=Selecionar  Espa‡o=Definir padr„o  F5=Atualizar  "
          Case Campo_Disp="TG_ARQUIVOS":
               TECLA=Chr(27)+""+Chr(26)+"=Selecionar  "
        EndSwitch
EndIf

If Campo_Disp="YES"     Or Campo_Disp="NO" Or
   Campo_Disp="ARQ_YES" Or Campo_Disp="ARQ_NO"
   Then 
        ;;;;;MSG_CAMPO=MSG_CAMPO+" [ENTER]"
   Else If Not IsBlank(MSG_CAMPO)
           Then If MSG_CAMPO<>"."
                   Then MSG_CAMPO=MSG_CAMPO+" [TAB]  "
                   Else MSG_CAMPO=Fill(" ",80)
                EndIf
        EndIf
EndIf

@ 23,0 ?? Format("W80,AR",MSG_CAMPO)
@ 24,0 ?? Format("W80,AL"," Esc=[Cancela]  Enter=[Ok]  "+TECLA)
PaintCanvas Attribute SYS_COR_RODAPED 23,00,23,79

;;;;;If Campo_Disp="YES"     Or Campo_Disp="NO" Or
;;;;;   Campo_Disp="ARQ_YES" Or Campo_Disp="ARQ_NO"
;;;;;   Then PaintCanvas Attribute SYS_COR_RODAPE 23,72,23,79
;;;;;   Else PaintCanvas Attribute SYS_COR_RODAPE 23,73,23,79
;;;;;EndIf
PaintCanvas Attribute SYS_COR_RODAPE 24,0,24,79

RefreshDialog  
EndProc            ; (Monta_Prompt_Disp)

;*******************************************************************************
;* IMPRIME RELATORIO VIDEO/ARQUIVO/IMPRESSORA
;*******************************************************************************
Proc ImpriRel(TABELA,RELAT)
Private TABELA,RELAT,CONTADOR,ARQTEMP,DIRTEMP,MSGTD,wc,comando

If Not IsAssigned(GERA_ARQUIVO_OCULTO)     Then GERA_ARQUIVO_OCULTO=False     EndIf
If Not IsAssigned(Sys_Visualiza_Relatorio) Then Sys_Visualiza_Relatorio="WIN" EndIf
If Not IsAssigned(PDFZEBRA)                Then PDFZEBRA               =False EndIf
If Not IsAssigned(IMAGEM_FUNDO)            Then IMAGEM_FUNDO=""               EndIf 
                    
While True
  CONTADOR=0
  Aguarde("Aguarde, Liberando Saida")
  If Not IsAssigned(Sys_Set_Video)
     Then Sys_Set_Video="01C  Padr„o    80x25"
  EndIf

  If Not IsAssigned(Seta_Printer)
     Then Seta_Printer="LPT1"
  EndIf
      
  If Seta_Printer="LPT1" Or
     Seta_Printer="LPT2" Or
     Seta_Printer="LPT3"
     Then SetPrinter Seta_Printer
  EndIf

  If DISPOSITIVO_OPCAO="V" And SubStr(Sys_Set_Video,3,1)<>"C"
     and Sys_Visualiza_Relatorio="DOS"
     Then {·} {Interface} {Yes}
          {·} {Video}
          For v From 1 to 2
            TypeIn SubStr(Sys_Set_Video,v+2,1)
          EndFor
          {·} {Interface} {Yes}
  EndIf

  Switch
  Case DISPOSITIVO_OPCAO="V" and Sys_Visualiza_Relatorio="WIN":
       If Not IsFile("C:\\vise\\xexe.exe")
          Then Mensagem("ExecVise nÆo instalado !")
               Return
       EndIf
       If IsFile("c:\\vise\\Vdpr.exe")
          Then
          Else Mensagem("DosPrinter nÆo instalado !")
               Return
       EndIf

       DIRTEMP=PrivDir()
       For Wc From 1 To 999
         ARQTEMP="Temp_"+AlinhM(StrVal(Wc),3)+".PDF"
         If Not IsFile(DIRTEMP+ARQTEMP)
             Then QuitLoop
         EndIf
       EndFor
;;;;;;;;;;;;;;;;;;;;;
       {Report} {Change} TypeIn TABELA Enter TypeIn RELAT Enter Enter
       Menu {Setting} {PageLayout} {Length} LR=Menuchoice() Enter
       If LR="60"
          Then Menu {Setting} {PageLayout} {Length} {66}
               Do_it!
          Else CancelEdit
       EndIf
;;;;;;;;;;;;;;;;;;;;;
       If OPCAOPAG="Todas"
          Then {Report} {OutPut} TypeIn TABELA Enter TypeIn RELAT Enter
          Else {Report} {RangeOutPut} TypeIn TABELA Enter TypeIn RELAT Enter
       EndIf

       If IsFile(DIRTEMP+ARQTEMP)
          Then {File} TypeIn DIRTEMP+ARQTEMP Enter {Replace}
          Else {File} TypeIn DIRTEMP+ARQTEMP Enter
       EndIf

       If OPCAOPAG<>"Todas"
          Then  TypeIn OPCAOPAGINI Enter
                TypeIn OPCAOPAGFIM Enter
       EndIf

       Renomeia_Arquivo(DIRTEMP+ARQTEMP+" "+SubStr(ARQTEMP,1,8))
       ARQTEMP=SubStr(ARQTEMP,1,8)

       Switch
         Case IsAssigned(Impressao_Orientacao) And Impressao_Orientacao="Paisagem":
              Switch
                Case IMAGEM_FUNDO<>"" : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF /LAND /IMAGE'C:\\VISE\\"+IMAGEM_FUNDO+".JPG,0,55,200' "+DIRTEMP+ARQTEMP)
                Case PDFZEBRA         : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF /LAND /IMAGE'C:\\VISE\\VZ.JPG,0,55,200' "+DIRTEMP+ARQTEMP)
                OtherWise             : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF /LAND "+DIRTEMP+ARQTEMP)
              EndSwitch
              Release Vars Impressao_Orientacao
         OtherWise:
              Switch
                Case IMAGEM_FUNDO<>"" : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF /IMAGE'C:\\VISE\\"+IMAGEM_FUNDO+".JPG,0,55,200' "+DIRTEMP+ARQTEMP)
                Case PDFZEBRA         : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF /IMAGE'C:\\VISE\\VZ.JPG,0,55,200' "+DIRTEMP+ARQTEMP)
                OtherWise             : ExecVise("EXE c:\\vise\\Vdpr.exe /DEL /PDF "+DIRTEMP+ARQTEMP)
              EndSwitch
       EndSwitch
       Release Vars Impressao_Orientacao, IMAGEM_FUNDO
       LimpAguarde()
       return
  Case DISPOSITIVO_OPCAO="A":
       Aguarde("Aguarde, Salvando")
       Tabela_cnv=Cria_Temp(PrivDir())
       Copy Tabela Tabela_cnv

       Switch
         Case Tipo_Docto=1:
              Comando="c:\\vise\\Vabc.exe \""+
                      TABELA_CNV+".db\" \""+DIREPORT+ARQUIVO+".CSV\" 1"
              Executa_Programa(comando)
              Sleep 1000
      ;  Case Tipo_Docto=2:
      ;       Comando="c:\\vise\\Vabc.exe \""+
      ;               TABELA_CNV+".db\" \""+DIREPORT+ARQUIVO+".XLS\" 0"
      ;       Executa_Programa(comando)
      ;       Sleep 1000
         
         Case Tipo_Docto=2:  ; novo testando
              If GERA_ARQUIVO_OCULTO
                 Then Comando="c:\\vise\\Vpxc.exe "+TABELA_CNV+".db "+DIREPORT+ARQUIVO+".xls"
                 Else Comando="c:\\vise\\Vpxc.exe "+TABELA_CNV+".db "+DIREPORT+ARQUIVO+".xls /open"
              EndIf
              Executa_Programa(comando)
              Sleep 1000

      ;   Case Tipo_Docto=3:         ; este formato tem muitas restri‡äes, desabilitado An¡vel 20/02/2019
      ;        Comando="c:\\vise\\Vabc.exe \""+
      ;                TABELA_CNV+".db\" \""+DIREPORT+ARQUIVO+".DBF\" 3"
      ;        Executa_Programa(comando)
      ;        Sleep 1000
         Case Tipo_Docto=4:
              Comando="c:\\vise\\Vabc.exe \""+
                      TABELA_CNV+".db\" \""+DIREPORT+ARQUIVO+".XML\" 4"
              Executa_Programa(comando)
              Sleep 1000
         Case Tipo_Docto=5 Or Tipo_Docto=6:
              If IsFile("c:\\vise\\Vdpr.exe")
                 Then
                 Else Mensagem("DosPrint nÆo instalado !")
                      Return
              EndIf

              DIRTEMP=DIREPORT
              ARQTEMP=ARQUIVO+".RPT"

              If OPCAOPAG="Todas"
                 Then {Report} {OutPut} TypeIn TABELA Enter TypeIn RELAT Enter
                 Else {Report} {RangeOutPut} TypeIn TABELA Enter TypeIn RELAT Enter
              EndIf

              If IsFile(DIRTEMP+ARQTEMP)
                 Then {File} TypeIn DIRTEMP+ARQTEMP Enter {Replace}
                 Else {File} TypeIn DIRTEMP+ARQTEMP Enter
              EndIf
              
              If OPCAOPAG<>"Todas"
                 Then  TypeIn OPCAOPAGINI Enter
                       TypeIn OPCAOPAGFIM Enter
              EndIf

              Renomeia_Arquivo(DIRTEMP+ARQTEMP+" "+ARQUIVO+SubStr(Tipo_Ext,2,4))

              If Tipo_Docto=5
                 Then ExecVise("EXE c:\\vise\\Vdpr.exe /RTF "+DIRTEMP+ARQUIVO+SubStr(Tipo_Ext,2,4))
                 Else ExecVise("EXE c:\\vise\\Vdpr.exe /PDF "+DIRTEMP+ARQUIVO+SubStr(Tipo_Ext,2,4))
              EndIf

              ;Deleta_Arquivo(DIRTEMP+ARQUIVO)

              ;If IsTable(DIRTEMP+ARQUIVO)
              ;   Then Delete DIRTEMP+ARQUIVO
              ;EndIf
         Case Tipo_Docto=7:
              Comando="c:\\vise\\Vabc.exe \""+
                      TABELA_CNV+".db\" \""+DIREPORT+ARQUIVO+".MDB\" 2"
              Executa_Programa(comando)
              Sleep 1000
       EndSwitch
                      
       MSGTD=""
       Switch
         Case Tipo_Docto=1: MSGTD=".CSV"
         Case Tipo_Docto=2: MSGTD=".XLS"
         Case Tipo_Docto=3: MSGTD=".DBF"
         Case Tipo_Docto=4: MSGTD=".XML"
         Case Tipo_Docto=5: MSGTD=".RTF"
         Case Tipo_Docto=6: MSGTD=".PDF"
         Case Tipo_Docto=7: MSGTD=".MDB"
       EndSwitch

       If Not GERA_ARQUIVO_OCULTO
          Then Mensagem("Gerado arquivo: "+DIREPORT+ARQUIVO+MSGTD)
       EndIf    

       LimpAguarde()
  Case DISPOSITIVO_OPCAO="V":
       ClearPullDown
       If OPCAOPAG="Todas"
          Then {Report} {OutPut} TypeIn TABELA Enter TypeIn RELAT Enter
          Else {Report} {RangeOutPut} TypeIn TABELA Enter TypeIn RELAT Enter
       EndIf
       KeyDisable "F1"

       Prompt " F2=Sair/Dispositivo   F10=Menu   Ctrl+Z=Pesquisar   Alt+Z=Pr¢ximo   "

       {Screen}
       If OPCAOPAG<>"Todas"
          Then  TypeIn OPCAOPAGINI Enter
                TypeIn OPCAOPAGFIM Enter
       EndIf
       LimpAguarde()
       KeyEnable "F1"

       If SubStr(Sys_Set_Video,3,1)<>"C"
          Then {·} {Interface} {Yes}
               {·} {Video} {C: EGA/VGA: 80x25}
               {·} {Interface} {Yes}
       EndIf

       If IsAssigned(SYS_TITULO_MENU)
          Then TITSHOW=SYS_TITULO_MENU
          Else TITSHOW=""
       EndIf
       ShowPullDown
         TITSHOW : "" : ""
       EndMenu

       If IsAssigned(LoopdoDispositivo)
          Then If Not LoopdoDispositivo
                  Then QuitLoop
               EndIf
       EndIf
       Dispositivo()
       If OK=""
          Then QuitLoop
          Else Loop
       EndIf

  Case DISPOSITIVO_OPCAO="I": 

       Aguarde("Aguarde, Imprimindo")
       comando=""
       For i From 1 to NumVal(NUMCOPIA)
         If OPCAOPAG="Todas"
            Then {Report} {OutPut} TypeIn TABELA Enter TypeIn RELAT Enter
            Else {Report} {RangeOutPut} TypeIn TABELA Enter TypeIn RELAT Enter
         EndIf
         
         If Seta_Printer ="LPT1" Or
            Seta_Printer ="LPT2" Or
            Seta_Printer ="LPT3"
            Then {Printer}
            Else
                 DIRTEMP=PrivDir()
                 For Wc From 1 To 999
                   ARQTEMP="Temp_"+AlinhM(StrVal(Wc),3)+".TXT"
                   If Not IsFile(DIRTEMP+ARQTEMP)
                       Then QuitLoop
                   EndIf
                 EndFor

                If IsFile(DIRTEMP+ARQTEMP)
                   Then {File} TypeIn DIRTEMP+ARQTEMP Enter {Replace}
                   Else {File} TypeIn DIRTEMP+ARQTEMP Enter
                EndIf
         EndIf
         
         If OPCAOPAG<>"Todas"
            Then  TypeIn OPCAOPAGINI Enter
                  TypeIn OPCAOPAGFIM Enter
         EndIf

            If Seta_Printer ="LPT1" Or
               Seta_Printer ="LPT2" Or
               Seta_Printer ="LPT3"  
               Then 
                    ;If IsAssigned(Impressao_Orientacao) And Impressao_Orientacao="Paisagem"
                    ;   Then ExecVise("EXE c:\\vise\\Vdpr.exe /land /sel'"+Seta_Printer+":' "+DIRTEMP+ARQTEMP)
                    ;   Else ExecVise("EXE c:\\vise\\Vdpr.exe /raw /sel'"+Seta_Printer+":' "+DIRTEMP+ARQTEMP)
                    ;EndIf
               Else 
                  If Search("HP"     ,UPPER(Seta_Printer))>0 Or
                     Search("SAMSUNG",UPPER(Seta_Printer))>0 Or
                     Search("LASER"  ,UPPER(Seta_Printer))>0 Or
                     Search("JATO"   ,UPPER(Seta_Printer))>0 Or
                     Search("INKJET" ,UPPER(Seta_Printer))>0 Or
                     Search("XEROX"  ,UPPER(Seta_Printer))>0 Or
                     Search("DESKJET",UPPER(Seta_Printer))>0
                     Then If IsAssigned(Impressao_Orientacao) And Impressao_Orientacao="Paisagem"
                             Then comando="c:\\vise\\Vdpr.exe /land /sel'"+Seta_Printer+"' "+DIRTEMP+ARQTEMP
                             Else comando="c:\\vise\\Vdpr.exe /sel'"+Seta_Printer+"' "+DIRTEMP+ARQTEMP
                          EndIf   
                     Else If IsAssigned(Impressao_Orientacao) And Impressao_Orientacao="Paisagem"
                             Then comando="c:\\vise\\Vdpr.exe /land /sel'"+Seta_Printer+"' "+DIRTEMP+ARQTEMP 
                             Else comando="c:\\vise\\Vdpr.exe /raw /sel'"+Seta_Printer+"' "+DIRTEMP+ARQTEMP
                                  ; "/raw" nÆo imprime em impressoras JATO DE TINTA / LASER             
                          EndIf                
                  EndIf

                  FileWrite        PrivDir()+"funcao.txt" From "IMP|"+comando
                  For exe From 1 To 10
                    Sleep 1000
                    If Isfile(PrivDir()+"funcao.txt")
                       Then ExecVisecf(PrivDir()+"funcao.txt","IMPRIMIR") 
                            QuitLoop
                    EndIf
                    If exe = 10
                       Then Mensagem("Tempo limite de espera para impress„o excedido!//Verificar com o Suporte T‚cnico!")
                    EndIf   
                  EndFor
                  Release Vars exe  

                 ;;If Len(comando)>109
                 ;;   Then Mensagem("Caminho da Impressora muito longo !// //Verificar nome/caminho da mesma !// //Visualiza‡Æo em v¡deo !")
                 ;;        Deleta_Arquivo(DIRTEMP+ARQUIVO)
                 ;;        DISPOSITIVO_OPCAO="V"
                 ;;        comando="erro"
                 ;;        QuitLoop
                 ;;EndIf        
                 ;;
                 ;;ExecVise("EXE "+comando)

            EndIf
       EndFor

       if comando="erro" then loop endif

       SetPrinter "LPT1"
       If IsFile(PrivDir()+"Cfg_Imp.sc")
          Then Play PrivDir()+"Cfg_Imp"
       EndIf

       Mensagem("Impress„o Concluida !")

       LimpAguarde()
  EndSwitch
  QuitLoop
EndWhile

Cursor Normal
EndProc

;*******************************************************************************
; Rotina Monta Grafico                                                         *
;*******************************************************************************
Proc MONTAGRAFICO(GRAF_TAB)
Private Arq

While True
  If Sys_Visualiza_Grafico="WIN"
       Then If Not IsAssigned(MODGRAF) Then MODGRAF = 1 EndIf
            If IsFile("c:\\vise\\visegraf\\Windows\\vgrf2.exe")
               Then Echo Normal
                    Echo Off
                    ShowPopup " Visualiza‡„o de Gr fico " CENTERED
                    "Grafico 1  " : " Visualiza‡„o de Gr fico - Modelo 1 " : "G1",
                    "Grafico 2  " : " Visualiza‡„o de Gr fico - Modelo 2 " : "G2",
                    separator,
                    "~C~ancelar " : " Cancelar a Opera‡„o                " : "CANCELAR"
                    EndMenu
                    To MenuVar
                    Echo Off
                    
                    If MenuVar="CANCELAR" or MenuVar="Esc"
                       Then Return
                    EndIf
                      
                    Switch
                      Case MenuVar = "G1" : MODGRAF = 1
                      Case MenuVar = "G2" : MODGRAF = 2  
                    EndSwitch
               Else MSG=     "Foi detectado que vocˆ n„o tem o novo modelo de visualiza‡Æo de//"
                    MSG=MSG+ "gr fico instalado!                                             //"
                    MSG=MSG+ "D£vidas, entre em contato com o suporte Vise Inform tica.      "
                    Mensagem(MSG)
           EndIf
         
           Switch
            Case MODGRAF=2 : If Not IsFile("c:\\vise\\xexe.exe") And
                                Not IsFile("c:\\vise\\visegraf\\Windows\\vgrf2.exe") 
                                Then Mensagem("Visegraf 2 nÆo instalado !")
                                     Return
                             EndIf
            OtherWise      : If Not IsFile("c:\\vise\\xexe.exe") And
                                Not IsFile("c:\\vise\\Vgrf.exe") 
                                Then Mensagem("Visegraf nÆo instalado !")
                                     Return
                             EndIf
          EndSwitch
          GRAF_TAB2=Cria_Temp("c:\\vise\\visegraf\\")
          Copy GRAF_TAB GRAF_TAB2

          {Tools} {Info} {Structure} TypeIn GRAF_TAB Enter
          GRAF_CAMPOX=[Field Name] Down
          GRAF_CAMPOY1=[Field Name]
          Down
          GRAF_CAMPOY2=[Field Name]
          If GRAF_CAMPOY1 = GRAF_CAMPOY2
             Then GRAF_CAMPOY2=""
          EndIf

          ClearAll

          ;arq=PrivDir()+"visegraf.ini"
          arq="c:\\vise\\visegraf\\visegraf.ini"
          
          FileWrite        arq From ""
          FileWrite Append arq From "[DADOS]"+"\n"
          FileWrite Append arq From "BD=Paradox"+"\n"
          FileWrite Append arq From "NOMETABELA="+GRAF_TAB2+"\n"
          FileWrite Append arq From "CAMPOX="+GRAF_CAMPOX+"\n"
          FileWrite Append arq From "CAMPOY1="+GRAF_CAMPOY1+"\n"
          If Not IsBlank(GRAF_CAMPOY2)
             Then FileWrite Append arq From "CAMPOY2="+GRAF_CAMPOY2+"\n"
          EndIf
          FileWrite Append arq From "TITULOGRAFICO1="+GRAF_TIT1+"\n"
          FileWrite Append arq From "TITULOGRAFICO2="+GRAF_TIT2+"\n"
          FileWrite Append arq From "TIPOGRAFICO="+GRAF_TIPO+"\n"
          If IsAssigned(GRAF_LINY)
             Then FileWrite Append arq From "TITULOX="+GRAF_LINY+"\n"
                  If IsAssigned(GRAF_LINX)
                     Then FileWrite Append arq From "TITULOY="+GRAF_LINX+"\n"
                  EndIf
          EndIf
          If IsAssigned(GRAF_LENG)
             Then If GRAF_LENG="Y"
                     Then If IsAssigned(GRAF_LENG1)
                             Then FileWrite Append arq From "LEG1="+GRAF_LENG1+"\n"
                                  If IsAssigned(GRAF_LENG2)
                                     Then FileWrite Append arq From "LEG2="+GRAF_LENG2+"\n"
                                  EndIf
                          EndIf
                  EndIf
          EndIf
          FileWrite Append arq From "CAMINHOBD=c:\\vise\\visegraf\\"+"\n"
          FileWrite Append arq From "USUARIO="+"\n"
          FileWrite Append arq From "SENHATB="+"\n"

          If MODGRAF = 2
             Then ExecVise("EXE c:\\Vise\\visegraf\\Windows\\vgrf2.exe "+arq)
             Else ExecVise("EXE c:\\Vise\\Vgrf.exe "+arq)
          EndIf   
          return
  EndIf

  Aguarde("Aguarde, Liberando Saida")

  ; GRAF_TAB: Tabela na qual sera visualizada o Grafico
  ; GRAF_TIT1: 1§ Titulo do Grafico
  ; GRAF_TAM1: Tamanho dos Caracteres
  ; GRAF_TIT2: 2§ Titulo do Grafico

  ; GRAF_TAM2: Tamanho dos Caracteres
  ; GRAF_FONT: Tipo da Fonte
  ; GRAF_LINX: Titulo do eixo X
  ; GRAF_LINY: Titulo do eixo Y
  ; GRAF_TAM3: Tamanho da Fonte
  ; GRAF_LENG: Legendado ? Yes ou No
  ; GRAF_LENG1: Legenda Campo 1
  ; GRAF_LENG2: Legenda Campo 2
  ; GRAF_LENG3: Legenda Campo 3
  ; GRAF_LAB : Formato do Rotulo

  ; GRAF_GRID: Tipo do Grid 
  ; GRAF_CSFRM: Cor da Borda
  ; GRAF_CSGRID: Cor da Grid 
  ; GRAF_CSTIT1: Cor do 1§ Titulo
  ; GRAF_CSTIT2: Cor do 2§ Titulo

  ; GRAF_CSLINX: Cor do Eixo X
  ; GRAF_CSLINY: Cor do Eixo Y
  ; GRAF_CGRID: Cor Grid  1
  ; GRAF_CPAL: Cor da Paleta
  ; GRAF_EXP: Explosao do Grafico de Torta

  Menu {Image} {Graph} {Reset} {Ok}
  {View} TypeIn GRAF_TAB Enter CtrlEnd

  If IsAssigned(GRAF_CAMPO)
     Then For i From 1 to (GRAF_CAMPO-1)
                Left
          EndFor
  EndIf

  ;*** Tipo do Grafico *******
  Menu {Image} {Graph} {Modify}
  If IsAssigned(GRAF_TIPO)
     Then TypeIn GRAF_TIPO
     Else TypeIn "Line"
  EndIf

  ;*** Titulos do Grafico *******
  Menu {Overall} {Titles}
  If IsAssigned(GRAF_TIT1)
     Then CtrlHome CtrlBackspace  TypeIn GRAF_TIT1
     Else CtrlHome CtrlBackspace
  EndIf

  If IsAssigned(GRAF_TAM1)
     Then CtrlHome Down TypeIn GRAF_TAM1
     Else CtrlHome Down TypeIn "S"
  EndIf

  If IsAssigned(GRAF_TIT2)
     Then CtrlHome Down Down CtrlBackspace  TypeIn GRAF_TIT2
     Else CtrlHome Down Down CtrlBackspace
  EndIf

  If IsAssigned(GRAF_TAM2)
     Then CtrlHome Down Down Down TypeIn GRAF_TAM2
     Else CtrlHome Down Down Down TypeIn "S"
  EndIf

  If IsAssigned(GRAF_FONT)
     Then CtrlHome Down Down Down Down TypeIn GRAF_FONT
     Else CtrlHome Down Down Down Down TypeIn "J"
  EndIf

  If IsAssigned(GRAF_LINY)
     Then CtrlHome Down Down Down Down Down CtrlBackspace  TypeIn GRAF_LINY
     Else CtrlHome Down Down Down Down Down CtrlBackspace
  EndIf

  If IsAssigned(GRAF_LINX)
     Then CtrlHome Down Down Down Down Down Down CtrlBackspace  TypeIn GRAF_LINX
     Else CtrlHome Down Down Down Down Down Down CtrlBackspace
  EndIf

  If IsAssigned(GRAF_TAM3)
     Then CtrlHome Down Down Down Down Down Down Down TypeIn GRAF_TAM3
     Else CtrlHome Down Down Down Down Down Down Down TypeIn "A"
  EndIf

  ;*** Legenda do Grafico *******
  If IsAssigned(GRAF_LENG)
     Then Menu {Series} {LegendsAndLabels}  TypeIn GRAF_LENG
     Else Menu {Series} {LegendsAndLabels}  TypeIn "N"
  EndIf

  ;*** Legenda de Campos *******
  If IsAssigned(GRAF_LENG1)
     Then Menu {Series} {LegendsAndLabels} Down TypeIn GRAF_LENG1
     Else Menu {Series} {LegendsAndLabels} Down TypeIn ""
  EndIf

  If IsAssigned(GRAF_LENG2)
     Then Menu {Series} {LegendsAndLabels} Down Down TypeIn GRAF_LENG2
     Else Menu {Series} {LegendsAndLabels} Down Down TypeIn ""
  EndIf

  If IsAssigned(GRAF_LENG3)
     Then Menu {Series} {LegendsAndLabels} Down Down Down TypeIn GRAF_LENG3
     Else Menu {Series} {LegendsAndLabels} Down Down Down TypeIn ""
  EndIf


  ;*** Cores do Grafico *******
  Menu {Overall} {Colors} {Screen}
  If IsAssigned(GRAF_CSFRM)
     Then CtrlHome Down TypeIn GRAF_CSFRM
     Else CtrlHome Down TypeIn "J"
  EndIf

  If IsAssigned(GRAF_CSGRID)
     Then CtrlHome Down Down TypeIn GRAF_CSGRID
     Else CtrlHome Down Down TypeIn "J"
  EndIf

  If IsAssigned(GRAF_CSTIT1)
     Then CtrlHome Down Down Down TypeIn GRAF_CSTIT1
     Else CtrlHome Down Down Down TypeIn "E"
  EndIf

  If IsAssigned(GRAF_CSTIT2)
     Then CtrlHome Down Down Down Down TypeIn GRAF_CSTIT2
     Else CtrlHome Down Down Down Down TypeIn "E"
  EndIf

  If IsAssigned(GRAF_CSLINX)
     Then CtrlHome Down Down Down Down Down TypeIn GRAF_CSLINX
     Else CtrlHome Down Down Down Down Down TypeIn "E"
  EndIf

  If IsAssigned(GRAF_CSLINY)
     Then CtrlHome Down Down Down Down Down TypeIn GRAF_CSLINY
     Else CtrlHome Down Down Down Down Down TypeIn "E"
  EndIf

  ;*** Grid do Grafico *******
  Menu {Overall} {Grids}
  CtrlEnd TypeIn "Y"
  If IsAssigned(GRAF_GRID)
     Then CtrlHome TypeIn GRAF_GRID
     Else CtrlHome TypeIn "5"
  EndIf

  If IsAssigned(GRAF_CGRID)
     Then CtrlHome Down TypeIn GRAF_CGRID
     Else CtrlHome Down TypeIn "J"
  EndIf

  If IsAssigned(GRAF_CPAL)
     Then CtrlHome Down Down Down TypeIn GRAF_CPAL
     Else CtrlHome Down Down Down TypeIn "B"
  EndIf

  ;*** Grafico Tipo Torta *******
  If GRAF_TIPO="P"
     Then Menu {Pies}
          If IsAssigned(GRAF_LAB)
             Then TypeIn GRAF_LAB
             Else TypeIn "P"
          EndIf

          If IsAssigned(GRAF_EXP)
             Then Down Right Right TypeIn GRAF_EXP
             Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y"
             Else Down Right Right TypeIn "Y"
             Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y" Down "Y"
          EndIf
  EndIf

  ;*** Grafico Ajustes da Pagina *******
  Menu {Overall} {PrinterLayout} Enter
  CtrlBackspace  "0.5" Enter CtrlBackspace  "0.5" Enter
  CtrlBackspace  "9.5" Enter CtrlBackspace  "7.5" Enter
  "p" Enter
  "y" Enter
  
  Switch
    Case Ok="V":
         Menu {ViewGraph} {Screen}
         Do_It!
         ClearAll

         DispositivoG()
         If OK=""
            Then QuitLoop
            Else Loop
         EndIf

    Case OK="I":
         Menu {Overall} {Device} {Printer}
         If OpcaoE="Jato de Tinta"
            Then If SETA_PRINTER="LPT1" Then {1stPrinter} EndIf
                 If SETA_PRINTER="LPT2" Then {3rdPrinter} EndIf
            Else If SETA_PRINTER="LPT1" Then {2ndPrinter} EndIf
                 If SETA_PRINTER="LPT2" Then {4thPrinter} EndIf
         EndIf
         Aguarde("Aguarde, Imprimindo")
         For i From 1 to NumVal(NUMCOPIA)
           Menu {ViewGraph} {Printer}
         EndFor
         LimpAguarde()
         If OK="I"
            Then Mensagem("Impress„o Concluida !")
         EndIf
  EndSwitch
  Do_It!
  ClearAll

  QuitLoop
EndWhile

Release Vars arq
EndProc

;*******************************************************************************
; Rotina para pegar numeros depois do ponto sem arredondar                     *
;*******************************************************************************
Proc NDecimal(VALOR,TAMANHO)
Private wvalor, TAMANHO
If Not IsBlank(VALOR)
   Then wvalor=Format("W20.5,IC",VALOR)
        If Search(".",StrVal(wvalor))>0
           Then VALOR=NumVal(SubStr(wvalor,1,Search(".",wvalor)+TAMANHO))
        EndIf
EndIf
Return VALOR
EndProc

;*******************************************************************************
; Rotina para Montagem String de Barra de Porcentagem                          *
;*******************************************************************************
Proc Barra(Barra_NReg, Barra_RegN)
Private Barra_NReg, Barra_RegN, Barra_Porc
Barra_Porc=Int(((Barra_RegN/Barra_NReg)*100))
Barra_STRING=Chr(91)+Chr(254)
For Barra_i From 1 To Int(Barra_Porc/5)
  Barra_STRING=Barra_STRING+Chr(254)
EndFor
Barra_STRING=Completa(Barra_STRING,22," ")+Chr(93)+Format("W3,AR",StrVal(Barra_Porc))+"%"

Return BARRA_STRING
EndProc

;*******************************************************************************
;* Rotina Dialog Acesso p/ Supervisor                                          *
;*******************************************************************************
Proc Supervisor_Dialog(Disparo_Sup,Campo_Sup,Evento_Sup,Elemento_Sup)
Temp=True
TECLA    =""
MSG_Campo_Sup=""
If Disparo_Sup="OPEN"
   Then Campo_Sup=Campo_Sup_Ini
EndIf
If Disparo_Sup="EVENT" And Evento_Sup["Type"]="KEY" Then
   Switch
     Case Evento_Sup["KeyCode"] =  27:
          Temp=False
          Switch
            Case Campo_Sup="TG_USUARIO"       : Campo_Sup="NO"
            Case Campo_Sup="TG_SENHA"         : Campo_Sup="TG_USUARIO"
            Case Campo_Sup="YES" Or Campo_Sup="NO": Campo_Sup="TG_USUARIO"
          EndSwitch
     Case Evento_Sup["KeyCode"] = 13:
          Temp=False
          Switch
            Case Campo_Sup="TG_USUARIO"     :
                 VSDGUSUARIO=ControlValue("TG_USUARIO")
                 VSDGUSUARIO=ALINHM(VSDGUSUARIO,4)
                 
                 GetRecord "\\Sistemas\\Cadastro\\Usuarios" VSDGUSUARIO To reg_usuarios  
                 if retval
                    then VSDGNOMUSUARIO =reg_usuarios["Nome"]
                         Campo_Sup="TG_SENHA"
                    Else MENSAGEM("Usu rio n„o cadastrado !")
                 EndIf
                 If VSDGUSUARIO<>USUARIOANT
                    Then USUARIOANT=VSDGUSUARIO
                         CS=1
                 EndIf
            Case Campo_Sup="TG_SENHA"       : Campo_Sup="YES"
                 VSDGSENHA  =ControlValue("TG_SENHA")
						Case Campo_Sup="YES":
								 MSG_CAMPO_Sup="Executando"
								 AcceptDialog
								 
						Case Campo_Sup="NO" :
								 MSG_CAMPO_Sup="Cancelando"
								 CancelDialog
								 
          EndSwitch
          RefreshDialog
   EndSwitch
EndIf

Switch
  Case Campo_Sup="TG_USUARIO":
       MSG_Campo_Sup="Informe o c¢digo do usu rio \"SUPERVISOR\""
  Case Campo_Sup="TG_SENHA":
       MSG_Campo_Sup="Informe a senha do usu rio \"SUPERVISOR\""
  Case Campo_Sup="NO" :
       MSG_Campo_Sup="[Enter]=Cancelar/Retornar !"
  Case Campo_Sup="YES":
       MSG_Campo_Sup="[Enter]=Confirmar Dados/Entrar !"
EndSwitch

SelectControl Campo_Sup

ExibeRodapeSD(MSG_Campo_Sup)
ExibeRodape(2,"Esc=Retornar  Enter=Avan‡ar  "+TECLA)
RefreshDialog

Return Temp
EndProc

;*******************************************************************************
;* Rotina Monta Janela Acesso p/ Supervisor                                    *
;*******************************************************************************
Proc Checa_Supervisor()
Private VSDGUSUARIO, VSDGNOMUSUARIO, VSDSENHA, USUARIOANT,
        sd_i, sd_index, acessook, CS, userok, msg

If Not IsAssigned(SYS_CHAPA_USUARIO) Or
   Not IsAssigned(SYS_NIVEL_USUARIO)
   Then Return True
   Else If SYS_NIVEL_USUARIO="S" Or SYS_NIVEL_USUARIO="E"
           Then SYS_CHAPA_SUPERVISOR=SYS_CHAPA_USUARIO
                SYS_NOME_SUPERVISOR =SYS_NOME_USUARIO
                SYS_NIVEL_SUPERVISOR=SYS_NIVEL_USUARIO
                Return True
        EndIf
EndIf

VSDGUSUARIO   =""
VSDGNOMUSUARIO=""
VSDGSENHA     =""

CS=1
USUARIOANT=""
Campo_Sup_Ini ="TG_USUARIO"
While True
  ShowDialog "Acesso p/ SUPERVISOR" Proc "Supervisor_Dialog"
    Trigger "OPEN","ARRIVE"
    Key "ENTER","ESC"
     @ 07,10   Height 07 Width 57

       Label  @ 0,0 "Usuario" for "TG_USUARIO"
       Accept @ 1,1  Width 7 "A4" picture "#*#" Tag "TG_USUARIO" to VSDGUSUARIO

       Label  @ 0,08 "Nome" for "TG_NOMUSUARIO"
       Accept @ 1,09 Width 35 "A30" picture "!*!" Tag "TG_NOMUSUARIO" to VSDGNOMUSUARIO

       Label  @ 0,44 "Senha" for "TG_SENHA"
       Accept @ 1,45 Width 9 "A6" picture "@*@" hidden Tag "TG_SENHA" to VSDGSENHA

       Pushbutton @ 03,13 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue
       Pushbutton @ 03,32 width 11 "~C~ancela" CANCEL                    Tag "NO"  To BottonValue

  EndDialog

  If Not RetVal
     Then Acessook=False
          QuitLoop
  EndIf

  If IsBlank(VSDGUSUARIO)
     Then MENSAGEM("Usu rio inv lido !")
          Acessook=False
          QuitLoop
  EndIf

  userok=false
  msg=""
  GetRecord "\\Sistemas\\Cadastro\\Usuarios" VSDGUSUARIO To reg_usuarios  
  if retval
     then ENCRIPTASENHA(VSDGSENHA)
          If SENHAENC<>reg_usuarios["Senha"] or IsBlank(VSDGSENHA)
             Then msg="Senha Inv lida !"
             else if reg_usuarios["Nivel de Acesso"]="S" or
                     reg_usuarios["Nivel de Acesso"]="E"   
                     then userok=true
                     else msg="Usu rio n„o ‚ um \"SUPERVISOR\" !"
                  endif
          endif
     else msg="Usu rio n„o cadastrado !"
  endif

  If not userok
     Then MENSAGEM(msg)
          CS=CS+1
          If CS<=3
             Then Campo_Sup_Ini="TG_SENHA"
                  Loop
             Else Mensagem("Acesso negado !")
                  Acessook=False
                  QuitLoop
          Endif
     else SYS_CHAPA_SUPERVISOR=reg_usuarios["Chapa"]
          SYS_NOME_SUPERVISOR =reg_usuarios["Nome" ]
          SYS_NIVEL_SUPERVISOR=reg_usuarios["Nivel de Acesso"]
  EndIf

  Acessook=True
  QuitLoop
EndWhile

release vars reg_usuarios

Return acessook
EndProc

;*******************************************************************************
;* Rotina p/ Criacao de Tabela Temporaria                                      *
;*******************************************************************************
Proc Cria_Temp(Diretorio)
Private Tabela,Wc,Diretorio
For Wc From 1 To 999
    Tabela="Temp_"+AlinhM(StrVal(Wc),3)
    If Not IsTable(Diretorio+Tabela)
       Then QuitLoop
    EndIf
EndFor
Return Diretorio+Tabela
EndProc

;*******************************************************************************
;* Rotina p/ Criacao de funcao.txt Temporaria                                  *
;*******************************************************************************
Proc Cria_FuncaoTemp(Diretorio)
Private Arquivo,Wc,Diretorio
For Wc From 1 To 999
    Arquivo="Temp_"+AlinhM(StrVal(Wc),3)
    If Not IsFile(Diretorio+Arquivo+".txt")
       Then If Not IsFile(Diretorio+Arquivo+".ret")
               Then QuitLoop
            EndIf  
    EndIf
EndFor
Return Diretorio+Arquivo
EndProc

;*******************************************************************************
;* Rotina Retornar o ultimo dia do mes                                         *
;*******************************************************************************
Proc Ultimo_Dia(MMAAAA)
Private MMAAAA,MM,AAAA,DataValida
MM  =NumVal(SubStr(MMAAAA,1,2))+1
AAAA=NumVal(SubStr(MMAAAA,3,4))
If MM=13
   Then MM=1
        AAAA=AAAA+1
EndIf
DataValida=DateVal(StrVal(MM)+"/"+"01"+"/"+StrVal(AAAA))-1
Return DataValida
EndProc

;*******************************************************************************
;* Rotina Retornar o primeiro dia do mes                                       *
;*******************************************************************************
Proc Primeiro_Dia(MMAAAA)
Private MMAAAA,MM,AAAA,DataValida
MM  =NumVal(SubStr(MMAAAA,1,2))
AAAA=NumVal(SubStr(MMAAAA,3,4))
DataValida=DateVal(StrVal(MM)+"/"+"01"+"/"+StrVal(AAAA))
Return DataValida
EndProc     

;*******************************************************************************
;* Rotina para retornar o ultimo dia do mes posterior                          *
;*******************************************************************************
Proc PrimeiroDia_MesAnterior(PARAM)   
;Private AUX_DATA, AUX_MES, AUX_ANO, PARAM

If Type(PARAM)<>"D"
   Then Return BlankDate()
EndIf   

return Primeiro_Dia_Data(Primeiro_Dia_Data(param)-1)

;AUX_MES = NumVal(Month(PARAM))
;AUX_ANO = NumVal(Year(PARAM))
;
;If AUX_MES = 1
;   Then AUX_MES = 12
;        AUX_ANO = AUX_ANO - 1
;   Else AUX_MES = AUX_MES - 1
;EndIf            
;          
;AUX_MES  = AlinhM(StrVal(AUX_MES),2)
;AUX_DATA = DateVal("01."+AUX_MES+"."+StrVal(AUX_ANO))

;Release Vars AUX_MES, AUX_ANO, PARAM      
;Return AUX_DATA

EndProc ;PrimeiroDia_MesAnterior()

;*******************************************************************************
;* Rotina para retornar o primeiro dia do mes anterior                         *
;*******************************************************************************
Proc UltimoDia_MesPosterior(PARAM)
;Private AUX_DATA, AUX_MES, AUX_ANO, PARAM

If Type(PARAM)<>"D"
   Then Return BlankDate()
EndIf   

return Ultimo_Dia_Data(Ultimo_Dia_Data(param)+1)


;AUX_MES = NumVal(Month(PARAM))
;AUX_ANO = NumVal(Year(PARAM))
;
;If AUX_MES = 12
;   Then AUX_MES = 1
;        AUX_ANO = AUX_ANO + 1
;   Else AUX_MES = AUX_MES + 1
;EndIf            
;          
;AUX_MES  = AlinhM(StrVal(AUX_MES),2)
;AUX_ANO  = Strval(AUX_ANO)
;AUX_DATA = AUX_MES+AUX_ANO 
;
;AUX_DATA = Ultimo_Dia(AUX_DATA)
;
;Release Vars AUX_MES, AUX_ANO, PARAM      
;Return AUX_DATA

EndProc ;UltimoDia_MesPosterior()

;*******************************************************************************
;* Rotina Verifica se tem tabela (s) no Diretorio                               *
;*******************************************************************************
Proc Tem_Tabelas(Pasta)
Private Pasta,c,tabela
c=0
{Tools} {Info} {Inventory} {Tables} TypeIn Pasta Enter
Scan
  Tabela=Pasta+"\\"+[List->Name]
  If Not IsEmpty(tabela)
     Then c=c+1
  EndIf
EndScan
ClearAll
If c=0
   Then Return False
   Else Return True
EndIf

Release Vars Pasta, c, tabela
EndProc    ;  (Tem_Tabelas)

;*******************************************************************************
;* Rotina Criar Pasta  (MD)                                                     *
;*******************************************************************************
Proc Cria_Pasta(Pasta)
Private Pasta, comando

comando="MD "+Pasta+" >Nul"
@ 22,00 Run NoRefresh comando
Sleep 1000

Release Vars Pasta, comando
EndProc

;*******************************************************************************
;* Rotina Deleta Pasta  (RD)                                                    *
;*******************************************************************************
Proc Deleta_Pasta(Pasta)
Private Pasta

ExecVise("DELT "+Pasta)

Release Vars Pasta
EndProc

;*******************************************************************************
;* Rotina Deleta Arvore - Arquivos/Pastas/SubPastas (Deltree)                   *
;*******************************************************************************
Proc Deleta_Arvore(Pasta)
Private Pasta

ExecVise("DELT "+Pasta)

Release Vars Pasta
EndProc

;*******************************************************************************
;* Rotina Renomeia Arquivo  (Ren)                                               *
;*******************************************************************************
Proc Renomeia_Arquivo(param)
Private param, comando

comando="Ren "+Param+" >Nul"
@ 22,00 Run NoRefresh comando

Release Vars Param, comando
EndProc

;*******************************************************************************
;* Rotina Copia Arquivo (Copy)                                                 *
;*******************************************************************************
Proc Copia_Arquivo(param)
Private param, comando

ExecVise("COP "+Param)
      
Release Vars Param, comando
EndProc

;*******************************************************************************
;* Rotina Copia Arquivo (XCopy)                                                *
;*******************************************************************************
Proc XCopia_Arquivo(param)
Private param, comando

Switch
  Case IsFile("c:\\windows\\system32\\Xcopy.exe"): comando="c:\\windows\\system32\\"
  Case IsFile("c:\\vise\\util\\Xcopy.exe")       : comando="c:\\vise\\util\\"
  OtherWise                                      : comando=""
EndSwitch
comando=comando+"Xcopy "+Param+" /y >nul"
      
@ 22,00 Run NoRefresh comando
Sleep 2000

Release Vars Param, comando
EndProc

;*******************************************************************************
;* Rotina Deletar Arquivo  (Del)                                                *
;*******************************************************************************
Proc Deleta_Arquivo(NomeArquivo)
Private NomeArquivo,Pos_Barra,Aux_Pos_Barra,Aux_Pos_Ponto,Pos_Ponto,Aux_NomeArquivo,Aux_Extensao

Aux_NomeArquivo=NomeArquivo
If Search(".BAT",Upper(NomeArquivo))=0
   Then Aux_NomeArquivo=NomeArquivo 
        Pos_Barra=Search("\\",Aux_NomeArquivo)
        While Pos_Barra>0
          Aux_NomeArquivo = SubStr(Aux_NomeArquivo,Pos_Barra+1,Len(Aux_NomeArquivo)) 
          Pos_Barra = Search("\\",Aux_NomeArquivo)
        EndWhile  
        
        Aux_Extensao=Aux_NomeArquivo
        Aux_Pos_Ponto=Search(".",Aux_Extensao)
        While Aux_Pos_Ponto>0
          Aux_Extensao = SubStr(Aux_Extensao,Aux_Pos_Ponto+1,Len(Aux_Extensao))
          Pos_Ponto = Aux_Pos_Ponto   
          Aux_Pos_Ponto = Search(".",Aux_Extensao)>0    
        EndWhile
        Aux_NomeArquivo = SubStr(Aux_NomeArquivo,1,Pos_Ponto-1)
EndIf        

If Len(Aux_NomeArquivo)<=8 Or Search(".BAT",Upper(NomeArquivo))>0
   Then comando="Del "+NomeArquivo
        @ 22,00 Run NoRefresh comando
        Sleep 1000
   Else ExecVise("DELT "+NomeArquivo)
        Sleep 1000
EndIf   

Release Vars NomeArquivo 
EndProc

;*******************************************************************************
;* Rotina Executa Programa                                                     *
;*******************************************************************************
Proc Executa_Programa(param)
Private param, comando

If Not IsFile("c:\\vise\\xexe.exe")
   Then comando="\\sistemas\\cadastro\\xexe Cop \\sistemas\\cadastro\\xexe.exe c:\\vise\\xexe.exe"
        @ 22,00 Run NoRefresh comando 
        Sleep 1000 
EndIf        
ClearImage

comando=param

If Search(">",param)>0
   Then comando=param
   Else comando=param+" >nul"
EndIf

@ 22,00 Run NoRefresh comando

Release Vars Param, comando
EndProc

;*******************************************************************************
;* Rotina Executa Programa                                                     *
;*******************************************************************************
Proc ExecVise(param)
Private param, comando
If Not IsFile("c:\\vise\\xexe.exe")
   Then comando="\\sistemas\\cadastro\\xexe Cop \\sistemas\\cadastro\\xexe.exe c:\\vise\\xexe.exe"
        @ 22,00 Run NoRefresh comando
        Sleep 1000 
EndIf        

comando="c:\\vise\\xexe "
      
If Search(">",param)>0
   Then comando=comando+param
   Else comando=comando+param+" >nul"
EndIf

@ 22,00 Run NoRefresh comando

Release Vars Param, comando
EndProc

;*******************************************************************************
;* Rotina Executa Programa                                                     *
;*******************************************************************************
Proc ExecVisecf(arquivof,param)
Private arquivof,arquivoret,param,c,s,result

If Not IsFile("c:\\vise\\xexe.exe")
   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\xexe.exe c:\\vise\\xexe.exe"
        Sleep 1000 
EndIf        

If IsBlank(arquivof) 
   Then arquivof = PrivDir()+"funcao.txt"   
Endif   

If param <> "IMPRIMIR"
   Then arquivoret = SubStr(arquivof,1,Search(".",UPPER(arquivof)))+"ret"
        FileWrite arquivoret From ""
        
        If Not IsBlank(param)
           Then FileWrite arquivof From param
        EndIf
EndIf

@ 22,00 Run NoRefresh "c:\\vise\\xexe "+arquivof

If param<>"IMPRIMIR"
   Then For c From 1 to 60 
          If IsFile(arquivoret)
             Then FileRead arquivoret To s
                  Switch
                    Case Len(s)=0             : Sleep 500 Loop
                    Case SubStr(s,1,4)="True" : Return True 
                    Case SubStr(s,1,5)="False": Return False
                  EndSwitch
          EndIf   
          Sleep 500
        EndFor
EndIf

Return False  
EndProc

;*******************************************************************************
;* Rotina Executa Programa                                                     *
;*******************************************************************************
Proc ExecViseCons(arquivof,param)
Private arquivof,arquivoret,param,c,s,result

If Not IsFile("c:\\vise\\vcon.exe")
   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\vcon.exe c:\\vise\\vcon.exe"
        Sleep 1000 
EndIf        

If IsBlank(arquivof) 
   Then arquivof = PrivDir()+"funcao.txt"   
Endif   

If param <> "IMPRIMIR"
   Then arquivoret = SubStr(arquivof,1,Search(".",UPPER(arquivof)))+"ret"
        FileWrite arquivoret From ""
        
        If Not IsBlank(param)
           Then FileWrite arquivof From param
        EndIf
EndIf

@ 22,00 Run NoRefresh "\\sistemas\\cadastro\\vcon "+arquivof

If param<>"IMPRIMIR"
   Then For c From 1 to 60 
          If IsFile(arquivoret)
             Then FileRead arquivoret To s
                  Switch
                    Case Len(s)=0             : Sleep 500 Loop
                    Case SubStr(s,1,4)="True" : Return True 
                    Case SubStr(s,1,5)="False": Return False
                  EndSwitch
          EndIf   
          Sleep 500
        EndFor
EndIf

Return False  
EndProc
;*******************************************************************************
;* Rotina Executa Programa  Etiqueta bematech                                  *
;*******************************************************************************
Proc ExecViseBMT(arquivof,param)
Private arquivof,arquivoret,param,c,s,result

If Not IsFile("c:\\vise\\vbmt.exe")
   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\vbmt.exe c:\\vise\\vbmt.exe"
        Sleep 1000 
EndIf        

If IsBlank(arquivof) 
   Then arquivof = PrivDir()+"funcao.txt"   
Endif   

If param <> "IMPRIMIR"
   Then arquivoret = SubStr(arquivof,1,Search(".",UPPER(arquivof)))+"ret"
        FileWrite arquivoret From ""
        
        If Not IsBlank(param)
           Then FileWrite arquivof From param
        EndIf
EndIf

@ 22,00 Run NoRefresh "c:\\vise\\vbmt "+arquivof

If param<>"IMPRIMIR"
   Then For c From 1 to 60 
          If IsFile(arquivoret)
             Then FileRead arquivoret To s
                  Switch
                    Case Len(s)=0             : Sleep 500 Loop
                    Case SubStr(s,1,4)="True" : Return True 
                    Case SubStr(s,1,5)="False": Return False
                  EndSwitch
          EndIf   
          Sleep 500
        EndFor
EndIf

Return False  
EndProc
;*******************************************************************************
;* Rotina Executa Programa  Etiqueta bematech                                  *
;*******************************************************************************
Proc ExecViseZBR(arquivof,param)
Private arquivof,arquivoret,param,c,s,result

If Not IsFile("c:\\vise\\vZBR.exe")
   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\vZBR.exe c:\\vise\\vZBR.exe"
        Sleep 1000 
EndIf        

If IsBlank(arquivof) 
   Then arquivof = PrivDir()+"funcao.txt"   
Endif   

If param <> "IMPRIMIR"
   Then arquivoret = SubStr(arquivof,1,Search(".",UPPER(arquivof)))+"ret"
        FileWrite arquivoret From ""
        
        If Not IsBlank(param)
           Then FileWrite arquivof From param
        EndIf
EndIf

@ 22,00 Run NoRefresh "c:\\vise\\vZBR "+arquivof

If param<>"IMPRIMIR"
   Then For c From 1 to 60 
          If IsFile(arquivoret)
             Then FileRead arquivoret To s
                  Switch
                    Case Len(s)=0             : Sleep 500 Loop
                    Case SubStr(s,1,4)="True" : Return True 
                    Case SubStr(s,1,5)="False": Return False
                  EndSwitch
          EndIf   
          Sleep 500
        EndFor
EndIf

Return False  
EndProc
;*******************************************************************************
;* Rotina Ler conteudo do Arquivo                                              *
;*******************************************************************************
Proc LerConteudodoArquivo(Arq)
Private Arq

If ExisteArquivo(Arq,0)
   Then FileRead Arq to conteudodoarquivo
        Return True
   Else conteudodoarquivo=""
        Return false
EndIf     
EndProc

;*******************************************************************************
;* Rotina Checar existencia do Arquivo                                         *
;*******************************************************************************
Proc ExisteArquivo(arq,tentativas)
Private arq,tentativas,i,c,s,ii

;If Not IsFile("c:\\vise\\xexe.exe")
;   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\xexe.exe c:\\vise\\xexe.exe"
;        Sleep 1000 
;EndIf        

;If tentativas=0 Then tentativas=8 EndIf ;8 Tentativas equivale a 30 segundos
;If tentativas=0 Then tentativas=20 EndIf ;8 Tentativas equivale a 30 segundos

tentativas=10
For i From 1 to tentativas
  FileWrite PrivDir()+"funcaofe.ret" From ""
  FileWrite PrivDir()+"funcaofe.txt" From "FEX"+"|"+arq
  @ 22,00 Run NoRefresh "c:\\vise\\xexe "+PrivDir()+"funcaofe.txt"

  For c From 1 to 20
    s = ""
    FileRead PrivDir()+"funcaofe.ret" To s
    Switch
      Case Len(s)=0             : Sleep 1500
    
      Case SubStr(s,1,4)="True" : Return True 
    
      Case SubStr(s,1,5)="False":
           If i=tentativas 
              Then Return False
           EndIf
           Sleep 2000
           QuitLoop
    EndSwitch
   
  EndFor
EndFor

Return False  
EndProc

;*******************************************************************************
;* Rotina Checar existencia do Arquivo                                         *
;*******************************************************************************
Proc ExisteArquivoold(arq,tentativas)
Private arq,arqret,arqtxt,tentativas,i,c,s,result

result = 0
If Not IsFile("c:\\vise\\xexe.exe")
   Then @ 22,00 Run NoRefresh "Copy \\sistemas\\cadastro\\xexe.exe c:\\vise\\xexe.exe"
        Sleep 1000 
EndIf        

;If tentativas=0 Then tentativas=8 EndIf ;8 Tentativas equivale a 30 segundos
;If tentativas=0 Then tentativas=20 EndIf ;8 Tentativas equivale a 30 segundos

tentativas=10
For i From 1 to tentativas
  s = Cria_FuncaoTemp(PrivDir())
  arqret = s+".ret"
  arqtxt = s+".txt"

  FileWrite arqtxt From "FEX"+"|"+arq
  @ 22,00 Run NoRefresh "c:\\vise\\xexe "+arqtxt

  For c From 1 to 20
    If Not IsFile(arqret)
       Then 
            Sleep 1500
       Else 
            FileRead arqret To s
            Switch
              Case Len(s)=0             : Sleep 1500

              Case SubStr(s,1,4)="True" : result = 1
                                          Quitloop 

              Case SubStr(s,1,5)="False":
                   If i=tentativas 
                      Then result = 2
                           Quitloop
                      else
                           Sleep 2000
                           QuitLoop
                   endif
            EndSwitch
    EndIf   
  EndFor

  if result<>0 then Quitloop endIf
EndFor

Deleta_Arquivo(arqret)
Deleta_Arquivo(arqtxt)

if result=1 
   then return true
   else return false
endIf

EndProc

;*******************************************************************************
;* Rotina Ler conteudo do Arquivo                                              *
;*******************************************************************************
Proc LerConteudodoArquivo8(Arq)
Private Arq

If ExisteArquivo8(Arq,0)
   Then FileRead Arq to conteudodoarquivo
        Return True
   Else conteudodoarquivo=""
        Return false
EndIf     
EndProc


;*******************************************************************************
;* Rotina Checar existencia do Arquivo                                         *
;*******************************************************************************
Proc ExisteArquivo8(arq,tentativas)
Private arq,tentativas,i,c,s,ii

If tentativas=0 Then tentativas=15 EndIf ;8 Tentativas equivale a 30 segundos
For i From 1 to tentativas

    If not IsFile(arq)
       Then Sleep 1000
       Else Return True
    EndIf   
EndFor

Return False  
EndProc

;*******************************************************************************
;* Rotina Valida IE  (Dir)                                               *
;*******************************************************************************
Proc Valida_IE(IE,UF)

Numero = ""
resultado = True

Numero = Tira_CharNum(IE)
FileWrite        PrivDir()+"funcao1.txt"  From  "VIE|"+Numero+"|"+UF+"\n"
If ExecVisecf(PrivDir()+"funcao1.txt","")
   Then resultado = True
   Else resultado = False 
        Mensagem("IE Inv lida !")
EndIf

return  Resultado
EndProc    ; (Valida_IE)

;*;*******************************************************************************
;* Rotina Lista Diretorio  (Dir)                                                *
;*******************************************************************************
Proc Lista_Diretorio(Param)
Private wc
Aguarde("Aguarde, Verificando Pastas")
wc=0

If IsAssigned(Array_Lista_Diretorios)
   Then Release Vars Array_Lista_Diretorios
EndIf

DynArray Array_Lista_Diretorios[]

Deleta_Arquivo(PrivDir()+"Dir.INI")
Deleta_Arquivo(PrivDir()+"Dir.Txt")

FileWrite        PrivDir()+"Dir.INI" From "[EXECDIR] \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Origem="+Param+" \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Destino="+PrivDir()+"Dir.Txt \n"

ExecVise("Dir "+ PrivDir())
Sleep(1000)

Editor Open PrivDir()+"Dir.Txt"
While True
  Extrair_Linha()
  If IsBlank(Elinha)
     Then QuitLoop
  EndIf
  If Upper(STrim(SubStr(Elinha,1,8)))<>"ATUALIZA" And
     Upper(STrim(SubStr(Elinha,1,8)))<>"REPORTS"  And
     Upper(STrim(SubStr(Elinha,1,8)))<>"UTILITAR" And
     Upper(STrim(SubStr(Elinha,1,8)))<>"USUARIOS" And
     Upper(STrim(SubStr(Elinha,1,8)))<>"CUPOM"    And
     Upper(STrim(SubStr(Elinha,1,8)))<>"IMAGENS"  And
     Upper(STrim(SubStr(Elinha,1,8)))<>"NAO_UTIL"
     Then wc=wc+1
         Array_Lista_Diretorios[wc]=STrim(SubStr(Elinha,1,Len(Elinha)-1))
  EndIf
EndWhile
Do_It!

LimpAguarde()
Return wc
EndProc    ; (Lista_Diretorio)


;*******************************************************************************
;* Rotina Lista Diretorio somente arquivos  (DirF)                             *
;*******************************************************************************
Proc Lista_DiretorioF(Diretorio,Extensao)
Private wc
Aguarde("Aguarde, Verificando Pastas")
wc=0

If IsAssigned(Array_Lista_Diretorios)
   Then Release Vars Array_Lista_Diretorios
EndIf

DynArray Array_Lista_Diretorios[]

Deleta_Arquivo(PrivDir()+"Dir.INI")
Deleta_Arquivo(PrivDir()+"Dir.Txt")

FileWrite        PrivDir()+"Dir.INI" From "[EXECDIRF] \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Origem="+Diretorio+" \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Destino="+PrivDir()+"Dir.Txt \n"

ExecVise("DirF "+ PrivDir()+" "+Extensao)
Sleep(1000)

Editor Open PrivDir()+"Dir.Txt"
While True
  Extrair_Linha()
  If IsBlank(Elinha)
     Then QuitLoop
  EndIf
     wc=wc+1 
     Array_Lista_Diretorios[wc]=STrim(SubStr(Elinha,1,Len(Elinha)-1))
EndWhile
Do_It!

LimpAguarde()
Return wc
EndProc    ; (Lista_DiretorioF)

;*******************************************************************************
;* Rotina Lista Diretorio somente arquivos com Data  (DirD)                    *
;*******************************************************************************
Proc Lista_DiretorioD(Diretorio,Extensao,Ordenacao)
Private wc
Aguarde("Aguarde, Verificando Pastas")
wc=0

If IsAssigned(Array_Lista_Diretorios)
   Then Release Vars Array_Lista_Diretorios
EndIf

DynArray Array_Lista_Diretorios[]

Deleta_Arquivo(PrivDir()+"Dir.INI")
Deleta_Arquivo(PrivDir()+"Dir.Txt")

FileWrite        PrivDir()+"Dir.INI" From "[EXECDIRD] \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Origem="+Diretorio+" \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Destino="+PrivDir()+"Dir.Txt \n"

ExecVise("DirD "+ PrivDir()+" "+Extensao+" "+Ordenacao)
Sleep(1000)

Editor Open PrivDir()+"Dir.Txt"
While True
  Extrair_Linha()
  If IsBlank(Elinha)
     Then QuitLoop
  EndIf
     wc=wc+1 
     Array_Lista_Diretorios[wc]=STrim(SubStr(Elinha,1,Len(Elinha)-1))
EndWhile
Do_It!

LimpAguarde()
Return wc
EndProc    ; (Lista_DiretorioD)

;*******************************************************************************
;* Rotina Lista Diretorio somente arquivos  (DirF)                             *
;*******************************************************************************
Proc Lista_DiretorioFCOMERRO(Diretorio,Extensao)
Private wc
Aguarde("Aguarde, Verificando Pastas")
wc=0

If IsAssigned(Array_Lista_Diretorios)
   Then Release Vars Array_Lista_Diretorios
EndIf

DynArray Array_Lista_Diretorios[]

;---- Em 04.03.2015, por erros em meia duzia de clientes, talvez algo com o EXECVISE e a exclusÆo da fun‡Æo do Windows ----- 
;Deleta_Arquivo(PrivDir()+"Dir.INI")
;Deleta_Arquivo(PrivDir()+"Dir.Txt")

FileWrite        PrivDir()+"Dir.INI" From "[EXECDIRF] \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Origem="+Diretorio+" \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Destino="+PrivDir()+"Dir.Txt \n"

ExecVise("DirF "+ PrivDir()+" "+Extensao)
Sleep(1000)

Editor Open PrivDir()+"Dir.Txt"
While True
  Extrair_Linha()
  If IsBlank(Elinha)
     Then QuitLoop
  EndIf
     wc=wc+1 
     Array_Lista_Diretorios[wc]=STrim(SubStr(Elinha,1,Len(Elinha)-1))
EndWhile
Do_It!

LimpAguarde()
Return wc
EndProc    ; (Lista_DiretorioF)

;*******************************************************************************
;* Rotina Lista Diretorio somente arquivos com Data  (DirD)                    *
;*******************************************************************************
Proc Lista_DiretorioDCOMERRO(Diretorio,Extensao,Ordenacao)
Private wc
Aguarde("Aguarde, Verificando Pastas")
wc=0

If IsAssigned(Array_Lista_Diretorios)
   Then Release Vars Array_Lista_Diretorios
EndIf

DynArray Array_Lista_Diretorios[]

;---- Em 04.03.2015, por erros em meia duzia de clientes, talvez algo com o EXECVISE e a exclusÆo da fun‡Æo do Windows ----- 
;Deleta_Arquivo(PrivDir()+"Dir.INI")
;Deleta_Arquivo(PrivDir()+"Dir.Txt")

FileWrite        PrivDir()+"Dir.INI" From "[EXECDIRD] \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Origem="+Diretorio+" \n"
FileWrite Append PrivDir()+"Dir.INI" From "Path_Destino="+PrivDir()+"Dir.Txt \n"

ExecVise("DirD "+ PrivDir()+" "+Extensao+" "+Ordenacao)
Sleep(1000)

Editor Open PrivDir()+"Dir.Txt"
While True
  Extrair_Linha()
  If IsBlank(Elinha)
     Then QuitLoop
  EndIf
     wc=wc+1 
     Array_Lista_Diretorios[wc]=STrim(SubStr(Elinha,1,Len(Elinha)-1))
EndWhile
Do_It!

LimpAguarde()
Return wc
EndProc    ; (Lista_DiretorioD)

;*******************************************************************************
;* Rotina para Pegar posicao Form MultiRecords                                 *
;*******************************************************************************
Proc PegaPosForm()
Private wc,nt,nf,nc,pok

;If Not FormType("MultiRecord")
;   Then Return
;EndIf
If Not IsAssigned(Array_PosForm)
   Then DynArray Array_PosForm[]
EndIf

nt=table()
If Len(nt)>9
   Then wc=1
        While wc>0
          wc=SearchFrom("\\",nt,1)
          If wc=0
             Then wc=SearchFrom(":",nt,1)
          EndIf
          nt=RTrim(SubStr(nt,wc+1,50))
        EndWhile
EndIf
nf =Form()
nc =Field()
wc =1
pok=false
While wc<=DynArraySize(Array_PosForm)
  If RTrim(SubStr(Array_PosForm[wc],01,8))=nt And
     RTrim(SubStr(Array_PosForm[wc],10,2))=nf
     Then pok=true
          QuitLoop
  EndIf
  wc=wc+1
EndWhile
Array_PosForm[wc]=Completa(nt,08," ")+"|"+
                  Completa(nf,02," ")+"|"+
                  Completa(nc,25," ")+"|"

If FormType("MultiRecord")
   Then Array_PosForm[wc]=Array_PosForm[wc]+
                  AlinhM(StrVal(rowno()),02)+"|"+
                  AlinhM(StrVal(recno()),07)
   Else Array_PosForm[wc]=Array_PosForm[wc]+
                  AlinhM("0",02)+"|"+
                  AlinhM("0",07)
EndIf
EndProc

;*******************************************************************************
;* Rotina para Setar posicao Form MultiRecords                                 *
;*******************************************************************************
Proc SetaPosForm()
Private wc,nt,nf,nc,pok,nrv,prv

If Not IsAssigned(Array_PosForm)
   Then DynArray Array_PosForm[]
        Return
EndIf

nt=table()
If Len(nt)>9
   Then wc=1
        While wc>0
          wc=SearchFrom("\\",nt,1)
          If wc=0
             Then wc=SearchFrom(":",nt,1)
          EndIf
          nt=RTrim(SubStr(nt,wc+1,50))
        EndWhile
EndIf
nf =Form()
nc =Field()
wc =1
pok=false
While wc<=DynArraySize(Array_PosForm)
  If RTrim(SubStr(Array_PosForm[wc],01,8))=nt And
     RTrim(SubStr(Array_PosForm[wc],10,2))=nf
     Then pok=true
          QuitLoop
  EndIf
  wc=wc+1
EndWhile
If pok And
   FormType("MultiRecord") And
   NumVal(SubStr(Array_PosForm[wc],42,07))>0 And
   NumVal(SubStr(Array_PosForm[wc],39,02))>0
   Then If NImageRecords()>1
           Then nrv=NumVal(SubStr(Array_PosForm[wc],42,07))
                prv=NumVal(SubStr(Array_PosForm[wc],39,02))
                If NImageRecords()<nrv Then nrv=NImageRecords() EndIf
                If prv>NImageRecords() Then prv=NImageRecords() EndIf
                setrecordposition nrv prv
        EndIf
EndIf
Moveto Field RTrim(SubStr(Array_PosForm[wc],13,25))
Array_PosForm[wc]=Completa(nt,08," ")+"|"+
                  Completa(nf,02," ")+"|"+
                  Completa(nc,25," ")+"|"+
                  AlinhM("0",02)+"|"+
                  AlinhM("0",07)
EndProc

;*******************************************************************************
;* Rotina para Setar Cor Registro                                              *
;*******************************************************************************
Proc SetaCorRegistro(Tipo)
Private Tipo

Switch
 Case Tipo="Editar"       : SetHighLight Current Record  32  Field 47
 Case Tipo="Editar_Campo" : SetHighLight Current Field 47
 Case Tipo="Editando"     : SetHighLight Current Record  112 Field 47
 Case Tipo="Paginar"      : SetHighLight Current Record  79  Field 78 
 Case Tipo="Invisivel"    : SetHighLight Current Record  51  Field 51
 Case Tipo="Padrao"       : SetHighLight Current Record  112 Field 112
EndSwitch  

Endproc

;*******************************************************************************
;* Rotina para Checar se usuario ‚ da Empresa informada                        *
;*******************************************************************************
Proc IsUsuarioEmpresa(empresa)
private empresa

If Not IsAssigned(SYS_USUARIO_CODEMPR) Then SYS_USUARIO_CODEMPR=""  EndIf
If Not IsAssigned(SYS_NIVEL_USUARIO)   Then SYS_NIVEL_USUARIO  ="S" EndIf

If IsBlank(SYS_USUARIO_CODEMPR)
   Then Return True
EndIf
If SYS_NIVEL_USUARIO="S"
   Then Return True
EndIf

If empresa<>SYS_USUARIO_CODEMPR
   Then Mensagem("Usu rio sem permissÆo nesta tarefa para a Empresa "+empresa+" !")
        Return False
EndIf
        
Return True
EndProc

;*******************************************************************************
;* Rotina Dialog Leitura_Codigo_Barras                                         *
;*******************************************************************************
Proc SD_DialogLerCodBarra(Disparo,Campo,Evento,Elemento)
Temp=True
MSG_CAMPO=""
TECLA="// Esc=Retornar "
If Not IsAssigned(PARAM_QTD_CDBAR) Then PARAM_QTD_CDBAR="" EndIf
If Disparo="OPEN"
   Then INICIO_DIALOG=False
        Campo="TG_CODIGO"

        Dynarray WinArray_CDBarras[]
        Window handle Dialog To WinCDBarras
        Window GetAttributes WinCDBarras To WinArray_CDBarras
        WinArray_CDBarras["HASSHADOW"] = False
        WinArray_CDBarras["HASFRAME" ] = False
        Window SetAttributes WinCDBarras From WinArray_CDBarras

        Release vars WinCDBarras, WinArray_CDBarras 

EndIf        

If Disparo="EVENT" And Evento["Type"]="KEY" Then
   Switch
     Case Evento["KeyCode"] = 27:
          Temp=False
          Switch
             Case Campo="TG_CODIGO"         : CancelDialog   
          EndSwitch
      Case Evento["KeyCode"] = 13:
           Temp=False
           Switch
             Case Campo="TG_CODIGO"        : 
                Dados_Item=ControlValue("TG_CODIGO")
								AcceptDialog
           EndSwitch
   EndSwitch
EndIf
RefreshDialog

Switch
 Case Campo="TG_CODIGO"        : 
      If PARAM_QTD_CDBAR<>"N"
        Then
           MSG_CAMPO=" Informe s¢ [C¢digo] a [Quantidade]=1 ou informe [Quantidade]*[C¢digo] "
        Else
           MSG_CAMPO=" Informe s¢ [C¢digo] a [Quantidade]=1                                  "
      EndIf
EndSwitch

Monta_Prompt(MSG_CAMPO,TECLA)
Return Temp
EndProc

;*******************************************************************************
;* Rotina para Leitura do Codigo de Barras                                     *
;*******************************************************************************
Proc Ler_CDBarras(l,c)
Private l,c,Past,Pos

If Not IsAssigned(PARAM_QTD_CDBAR) Then PARAM_QTD_CDBAR="" EndIf

While True                  
      INICIO_DIALOG=True
      
      Echo Normal
      Echo Off

      Dados_Item=""
      Dados_QTD =1

      ShowDialog "Lendo C¢digo de Barras" Proc "SD_DialogLerCodBarra"
      Trigger "OPEN","ARRIVE"
      Key "ESC","ENTER"
       @ l,c Height 03 Width 82
        
        Label  @ 00,00 " Lendo Codigo de Barras -> "  For "TG_CODIGO"
        Accept @ 00,28 Width 36 "A33" Tag "TG_CODIGO" To Dados_Item
        
      EndDialog

      Mouse Show
      If Not RetVal
         Then Return False
      EndIf

      If Len(Dados_Item)=0
         Then Loop
      EndIf

      Past=SearchFrom("*",Dados_Item,1)

      If Past>0 And Not E_NumeroValido(SubStr(Dados_Item,1,Past-1))
         Then Mensagem("Quantidade invalida !")
              Loop
      EndIf                

      If Past>0                                                                                                    
        Then If PARAM_QTD_CDBAR<>"N"
                Then
                     Dados_QTD=NumVal(SubStr(Dados_Item,1,Past-1))
                     Dados_Item=RTrim(SubStr(Dados_Item,Past+1,30))
                Else 
                     Mensagem("Fun‡ao [Quantidade]*[C¢digo] nÆo permitida!")
                     Loop
             EndIf
      EndIf            

      if sys_Codigo_cliente="0171"
         then if len(Dados_Item)=12 then Dados_Item="0"+Dados_Item endif
      endif

      Echo Off
 
      Return True                

EndWhile

EndProc ; Ler_CDBarras()

;*******************************************************************************
;* Rotina para visualizar campo memo                                           *
;*******************************************************************************
Proc Ver_Memo(campo,linhai,colunai,altura,largura,titulo)

SoVerMemo = True 
ImageRights ReadOnly
Edita_Memo(campo,linhai,colunai,altura,largura,titulo)
ImageRights

Release Vars SoVerMemo         
EndProc ;Ver_Memo()       

;*******************************************************************************
;* Rotina para editar campo memo                                               *
;*******************************************************************************
Proc Edita_Memo(campo,linhai,colunai,altura,largura,titulo)
Private CAMPO, COLUNAI, LINHAI, ALTURA, LARGURA, TITULO,
        WinArray, Winarray6, ImageColorSettings, JANELA,
        JANELA2, CampoAnt, result

result=true

If Not IsAssigned(JANELA_DIALOG_DESABILITA) 
   Then Window Handle Dialog to JANELA
        If Janela>0 
           Then Dynarray WinArray6[]
                Window GetAttributes JANELA To WinArray6
                WinArray6["FLOATING"]=False
                Window SetAttributes JANELA From WinArray6
        EndIf
EndIf

CampoAnt =Field()

Moveto Field campo
FieldView

Window Move GetWindow() To -100, -100
Dynarray WinArray[]

Window GetAttributes GetWindow() To WinArray
WinArray["CANMAXIMIZE"]=False
WinArray["CANCLOSE"]   =False
WinArray["Title"]      =TITULO
WinArray["HEIGHT"]     =ALTURA
WinArray["WIDTH"]      =LARGURA
WinArray["ORIGINROW"]  =LINHAI
WinArray["ORIGINCOL"]  =COLUNAI
WinArray["HASFRAME" ] = True
WinArray["HASSHADOW"]  =True
WinArray["CANRESIZE"]  =True
WinArray["CANMOVE"]    =True
Window SetAttributes GetWindow() From WinArray

Dynarray ImageColorSettings[]
ImageColorSettings[01]=96
ImageColorSettings[02]=111
ImageColorSettings[03]=96 
ImageColorSettings[04]=96 
ImageColorSettings[18]=96
ImageColorSettings[19]=96 
ImageColorSettings[20]=96 

Window SetColors GetWindow() From ImageColorSettings

MSGCAMPO=""
Echo Normal
Echo Off

Switch
  Case IsAssigned(SoVerMemo) : 
    Prompt "["+Field()+"]"
    SpeedBar "["+Chr(17)+"]"  :"ESC",
             "~ESC=Fechar~"   :"ESC",
             "~?~"            :-94
    
    While True
      Wait Field
           Until "F2","ESC",-94
    
      Switch
        Case RetVal="F2" Or RetVal="ESC"   : CancelEdit QuitLoop
        Case RetVal=-94     : 
             MSG=    "    Esc= Fechar          //"
             MSG=MSG+"Ctrl+F1= Ajuda/Teclas [?] "
             MsgHelp("Teclas/Fun‡”es",MSG)
      EndSwitch
    
    EndWhile  
  
  OtherWise                  :  
    Prompt "["+Field()+"]"
    SpeedBar "["+Chr(17)+"]"  :"ESC",
             "~ESC=Ignorar~"  :"ESC",
             "~F2=Salvar~"    :"F2",
             "~?~"            :-94
    
    While True
      Wait Field
           Until "F2","ESC",-94
    
      Switch
        Case RetVal="F2"    : Do_It!     result=true  QuitLoop    
        Case RetVal="ESC"   : CancelEdit result=false QuitLoop
        Case RetVal=-94     : 
              MSG=    "    Esc= Voltar/Ignorar   //"
              MSG=MSG+"     F2= Salvar           //"
              MSG=MSG+"Ctrl+F1= Ajuda/Teclas [?] "
              MsgHelp("Teclas/Fun‡”es",MSG)
      EndSwitch
    
    EndWhile
EndSwitch
ClearSpeedBar

If Not IsAssigned(JANELA_DIALOG_DESABILITA) 
   Then Window Handle Dialog to JANELA
        If Janela>0 
           Then Window Select JANELA
                WinArray6["FLOATING"]=True
                Window SetAttributes JANELA From WinArray6
        EndIf    
EndIf      

echo Normal
echo off

Moveto Field CampoAnt
Prompt TECLA

Release Vars CAMPO, COLUNAI, LINHAI, ALTURA, LARGURA, TITULO,
             WinArray, Winarray6, ImageColorSettings, JANELA,
             JANELA_DIALOG_DESABILITA, CampoAnt

Return Result

EndProc 

;*******************************************************************************
;* Rotina p/ Montar a Memo                                                     *
;*******************************************************************************
Proc Monta_Mensagem_Memo(MSG)
Private Contador,PARAMETRO_CARACTER,MSG,NLinha,PosInicial,AUX_LIMITE,PosicaoC,
        PosInicial,AUX_ARRAY,Array_Temp2,TM_AUX,AUX_MSG,AUX_CONT
       
If Not IsAssigned(tpmsg)        Then tpmsg = ""           EndIf
If Not IsAssigned(ALINHA_TEXTO) Then ALINHA_TEXTO = False EndIf
If Not IsAssigned(CENTRALIZA_TEXTO) Then CENTRALIZA_TEXTO = False EndIf

;A PARTIR DE 17.11.2015 AS MENSAGENS TAMBEM PODERAO SER PASSADAS COMO PARAMETRO 
;SEM QUEBRAS E AUTOMATICAMENTE SE AJUSTARA EM QUANTAS LINHAS FOREM NECESSERIAS. 
;
;A VARIAVEL "ALINHA_TEXTO" SE RETORNADO COMO VERDADEIRO PODERA AUTOMATICAMENTE 
;ALINHAR O TEXTO TENDO OU NAO QUEBRA DE LINHAS.

;A VARIAVEL "CENTRALIZA_TEXTO" SE RETORNADO COMO VERDADEIRO PODERA AUTOMATICAMENTE 
;REMOVER OS ESPACAMENTOS µ ESQUERDA DO TEXTO, ASSIM SERA POSSIVEL CENTRALIZAR O TEXTO.

PARAMETRO_CARACTER = 73

;---- Adicionado em 13.09.2017 -> Monta registros quebrando linha a linha ------------------
If Search("\n",MSG)>0
   Then 
       AUX_MSG    = "" 
        For wu From 1 To Len(MSG)
          If SubStr(MSG,wu,1)="\n"
             Then AUX_MSG=AUX_MSG +"//"
             else AUX_MSG=AUX_MSG + SubStr(MSG,wu,1)
          EndIf
        EndFor
        MSG=AUX_MSG
        
        Release Vars AUX_MSG, wu
EndIf
  
DynArray Array_Temp2[]
NLinha     = 1
PosInicial = 1
AUX_LIMITE = False
While True
  PosicaoC = SearchFrom("//",MSG,PosInicial)
  If PosicaoC > 0
     Then
          AUX_ARRAY = SubStr(MSG,PosInicial,PosicaoC - PosInicial)
          If Len(AUX_ARRAY) > PARAMETRO_CARACTER
             Then AUX_LIMITE = True
                  While True
                    Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),3) + SubStr(AUX_ARRAY,1,PARAMETRO_CARACTER)
                    AUX_ARRAY = SubStr(AUX_ARRAY,PARAMETRO_CARACTER+1,Len(AUX_ARRAY))
                    If AUX_ARRAY = ""
                       Then QuitLoop
                    EndIf
                    NLinha = NLinha + 1    
                  EndWhile
             Else Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),3) + AUX_ARRAY
          EndIf         
          NLinha = NLinha+1
          PosInicial = PosicaoC + 2

     Else 

          AUX_ARRAY = SubStr(MSG,PosInicial,Len(MSG))
          If Len(AUX_ARRAY) > PARAMETRO_CARACTER
             Then AUX_LIMITE = True
                  While True
                    Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),3) + SubStr(AUX_ARRAY,1,PARAMETRO_CARACTER)
                    AUX_ARRAY = SubStr(AUX_ARRAY,PARAMETRO_CARACTER+1,Len(AUX_ARRAY))
                    If AUX_ARRAY = ""
                       Then QuitLoop
                    EndIf
                    NLinha = NLinha + 1    
                  EndWhile
             Else Array_Temp2[NLinha] = AlinhM(StrVal(NLinha),3) + AUX_ARRAY
          EndIf
          
          quitloop         
  EndIf
EndWhile

;---- Tamanho do Array da Mensagem ---------------------------------------------
Contador = 0
For i From 1 To DynArraySize(Array_Temp2)
   If DynArraySize(Array_Temp2) = 1 Then QuitLoop EndIf
   Contador = Contador + 1
   If i = DynArraySize(Array_Temp2) And
      Search("?",Rtrim(Ltrim(SubStr(Array_Temp2[i],4,Len(Array_Temp2[i]))))) > 0 And
      ConfGeralNao<>""
      Then Contador = Contador - 1
   EndIf
Endfor 

If Contador > 0
   Then Array Array_Temp[Contador]
        Contador = 0
        MSG_QUESTION = ""
        For i From 1 To DynArraySize(Array_Temp2)
          If Search("?",SubStr(Array_Temp2[i],4,Len(Array_Temp2[i]))) > 0  And i = DynArraySize(Array_Temp2) And ConfGeralNao<>""
             Then MSG_QUESTION = SubStr(Array_Temp2[i],4,Len(Array_Temp2[i]))
                  QuitLoop
          EndIf    
          Contador = Contador + 1
          Array_Temp[Contador] = SubStr(Array_Temp2[i],4,Len(Array_Temp2[i]))    
        EndFor
   Else Array Array_Temp[2]
        Array_Temp[1] = ""
        MSG_QUESTION = ""
        If DynArraySize(Array_Temp2) = 1
           Then Array_Temp[2] = SubStr(Array_Temp2[1],4,Len(Array_Temp2[1]))
        EndIf
EndIf   

Release Vars Contador,PARAMETRO_CARACTER,MSG,NLinha,PosInicial,AUX_LIMITE,
             PosicaoC,PosInicial,AUX_ARRAY,Array_Temp2,TM_AUX
  
Return True

EndProc ;Monta_Mensagem_Memo()


;*******************************************************************************
;* Rotina p/ Montar a Memo                                                     *
;*******************************************************************************
Proc Monta_Mensagem_LerMemo(MSG,ll)
Private Array_Temp2, lmwc, lmwi, posi, ntam , s
       
DynArray Array_Temp2[]
lmwc=0
posi=1

for lmwi from 1 to len(MSG)
  
    ntam=ll
    s=substr(msg,posi,ntam)
  
;    posbn=search("\n",s)  
;    if posbn>0
;       then s=substr(msg,posi,posbn)
;  
;    endif
    
    lmwc=lmwc+1
    Array_Temp2[lmwc] = AlinhM(strval(lmwc),4)+"|"+s   
    posi=posi+ntam
  
endfor 


Array Array_Temp[lmwc]
For lmwi From 1 To lmwc
  Array_Temp[lmwi] = SubStr(Array_Temp2[lmwi],6,len(ll))
EndFor

Return True

EndProc ;Monta_Mensagem_LerMemo()

;*******************************************************************************
;* Rotina Monta Janela de Mensagem                                             *
;*******************************************************************************
Proc Ler_Memo(titmsg,POSICAO_LIN,POSICAO_COL,DISPLAY_ALT,DISPLAY_LARG,MSG)
Private MSG,titmsg, lin23, lin24

;Criado p/ exibi‡Æo de mensagens (GetRecord, entre outros)

CENTRALIZA_TEXTO=False
ALINHA_TEXTO    =False
ConfGeralNao    =""

COR_MENSAGEM = "MEMO" 
tpmsg        = "Memo"

If Not Monta_Mensagem_Memo(MSG)
   Then Release Vars Array_Temp,titmsg,tpmsg,POSICAO_LIN,POSICAO_COL,DISPLAY_ALT,DISPLAY_LARG,
                     MSG,COR_MENSAGEM, ConfGeralNao,ALINHA_TEXTO ,CENTRALIZA_TEXTO
        Return False
EndIf   

;---- Tamanho Fixo para Largura ---------------
If DISPLAY_LARG < 30 Then DISPLAY_LARG = 30 EndIf
If DISPLAY_LARG >=76 Then DISPLAY_LARG = 77 EndIf

Mouse Show
Sound 700 5    

Showdialog titmsg Proc "SD_Mensagem"
Trigger "OPEN","ARRIVE"
Key "ESC"    
     
@ POSICAO_LIN,POSICAO_COL Height DISPLAY_ALT Width DISPLAY_LARG

PickArray @00,00 Height DISPLAY_ALT-2 width DISPLAY_LARG-2
Columns 1
  Array_Temp
   Tag "TG_Registro"
    To ArrayElement
Enddialog 
        
LimpaRodape(0)

Style Attribute 31
OK="S"
LimpaRodape(0)

Release Vars MSG, NLinhas, Linha_Msg,COR_MENSAGEM,DISPLAY_ALT,DISPLAY_LARG, 
             POSICAO_LIN,POSICAO_COL,ALINHA_TEXTO,CENTRALIZA_TEXTO

Style Attribute 31
Return True
        
EndProc ;Ler_Memo()

;****************************************************
;** ROTINA PARA ALINHAMENTO DE VARIAVEL DE MEMORIA **
;****************************************************
Proc AStrVal(VR,TAMAN)
Private VR,TAMAN
Return Fill(" ",TAMAN-Len(StrVal(VR)))+StrVal(VR)
EndProc

;*******************************************************************************
;* Rotina Mensagem campo nulo                                                  *
;*******************************************************************************
Proc IsFieldNull(campo)
If IsBlank(campo)
  Then FastMsg("Campo n„o pode ser nulo !")
       Return True
  Else Return False
EndIf       
Endproc

;*******************************************************************************
;* Rotina Mensagem Sem Funcoes                                                 *
;*******************************************************************************
Proc SemFuncoes()
FastMsg("Sem fun‡”es !")
Endproc

;*******************************************************************************
;* Rotina Mensagem Sem Ficha                                                   *
;*******************************************************************************
Proc SemFicha()
FastMsg("Sem ficha !")
Endproc

;*******************************************************************************
;* Rotina Mensagem Teclas Padrao                                               *
;*******************************************************************************
Proc MsgTeclasPadrao()
MSG=    "    Esc= Voltar Menu                 //"
MSG=MSG+"  Enter= Novo registro               //"
MSG=MSG+"     F7= Navegar                     //"
MSG=MSG+"     F3= Visualizar modo Lista/Ficha //"
MSG=MSG+"     F5= Filtrar                     //"
MSG=MSG+"  Alt+F= Fun‡”es                     //"
MSG=MSG+"Ctrl+F1= Ajuda/Teclas [?]            "
MsgHelp("Teclas/Fun‡”es",MSG)
Endproc

;*******************************************************************************
;* Rotina Mensagem Teclas Padrao Itens                                         *
;*******************************************************************************
Proc MsgTeclasPadraoIt()
MSG=    "    Esc= Voltar                      //"
MSG=MSG+"  Enter= Novo registro               //"
MSG=MSG+"     F7= Navegar                     //"
MSG=MSG+"     F3= Visualizar Ficha            //"
MSG=MSG+"  Alt+F= Fun‡”es                     //"
MSG=MSG+"   PgDn= Avan‡ar p gina ou Finalizar //"
MSG=MSG+"Ctrl+F1= Ajuda/Teclas [?]            "
MsgHelp("Teclas/Fun‡”es",MSG)
Endproc

;*******************************************************************************
;* Rotina Mensagem Teclas Padrao Itens2                                        *
;*******************************************************************************
Proc MsgTeclasPadraoIt2()
MSG=    "    Esc= Voltar                           //"
MSG=MSG+"  Enter= Novo registro                    //"
MSG=MSG+"     F7= Navegar                          //"
MSG=MSG+"     F3= Visualizar Ficha                 //"
MSG=MSG+"  Alt+F= Fun‡”es                          //"
MSG=MSG+"     Ctrl+"+Chr(26)+"= Avan‡ar p gina "+Chr(16)+">                   //"
MSG=MSG+"     Ctrl+"+Chr(27)+"= Voltar p gina  <"+Chr(17)+"                   //"
MSG=MSG+"  Page Down= Finalizar      ["+Chr(16)+"]   *Confirma/Gravar//"
MSG=MSG+"Ctrl+F1= Ajuda/Teclas [?]             "
MsgHelp("Teclas/Fun‡”es",MSG)
Endproc

;*******************************************************************************
;* Rotina Barra Funcoes                                                        *
;*******************************************************************************
Proc BarraPadrao()
private s

s=""
If Not IsAssigned(TECLA)    Then TECLA="" EndIf
;If IsAssigned(MSGCAMPO) and not isblank(MSGCAMPO) 
;   Then if not isblank(TECLA)
;           then s=","+MSGCAMPO
;           else s=   MSGCAMPO
;        EndIf
;endif   

Prompt TECLA+s
SpeedBar "["+Chr(254)+"]" :"ESC",
         "~Novo~"         :"ENTER",
         "~Navegar~"      :"UP",
         "~Fun‡”es~"      :-33,
         "~Ficha/Lista~"  :"F3",
         "~?~"            :-94
         
EndProc

;*******************************************************************************
;* Rotina Barra Funcoes                                                        *
;*******************************************************************************
Proc BarraPadraoCF()
If Not IsAssigned(TECLA) Then TECLA="" EndIf

Switch
  Case (IsAssigned(MODOFILTRAR)       And MODOFILTRAR) And
       (IsAssigned(MODOFILTRARINCLUI) And Not MODOFILTRARINCLUI):
    Prompt TECLA 
    SpeedBar "["+Chr(254)+"]" :"ESC",
             "~....~"         :"ENTER",
             "~Navegar~"      :"UP",
             "~Fun‡”es~"      :-33,
             "~Ficha/Lista~"  :"F3",
             "~Filtrar~"      :"F5",
             "~?~"            :-94

  OtherWise:
    
    Prompt TECLA 
    SpeedBar "["+Chr(254)+"]" :"ESC",
             "~Novo~"         :"ENTER",
             "~Navegar~"      :"UP",
             "~Fun‡”es~"      :-33,
             "~Ficha/Lista~"  :"F3",
             "~Filtrar~"      :"F5",
             "~?~"            :-94
EndSwitch

EndProc

;*******************************************************************************
;* Rotina Barra Funcoes Itens                                                  *
;*******************************************************************************
Proc BarraPadraoIt()
If Not IsAssigned(TECLA) Then TECLA="" EndIf

Prompt TECLA 
SpeedBar "["+Chr(17)+"]"  :"ESC",
         "~Novo~"         :"ENTER",
         "~Navegar~"      :"UP",
         "~Fun‡”es~"      :-33,
         "~Ficha~"        :"F3",
         "~?~"            :-94,
         "["+Chr(16)+"]"  :"PGDN"


Endproc

;*******************************************************************************
;* Rotina Barra Funcoes Itens                                                  *
;*******************************************************************************
Proc BarraPadraoIt2()
If Not IsAssigned(TECLA) Then TECLA="" EndIf

Prompt TECLA 
SpeedBar "["+Chr(17)+"]"  :"ESC",
         "~Novo~"         :"ENTER",
         "~Navegar~"      :"UP",
         "~Fun‡”es~"      :-33,
         "~Ficha~"        :"F3",
         Chr(060)+Chr(17) :-115,
         Chr(16)+Chr(062) :-116,
         "~?~"            :-94,
         "["+Chr(16)+"]"  :"PGDN"


Endproc

;*******************************************************************************
;* Rotina checa se ‚ tecla de atalhado do menu                                 *
;*******************************************************************************
Proc IsTeclaAtalho()
If RetVal=-104 Or RetVal=-105 Or RetVal=-106 Or RetVal=-107 Or
   RetVal=-108 Or RetVal=-109 Or RetVal=-110 Or RetVal=-111 Or
   RetVal=-112 Or RetVal=-113 Or RetVal=-139 Or RetVal=-140 Or
   RetVal=-22  Or RetVal=-18
   Then SYS_TECLA_ACIONADA=RetVal
        Seta_Tecla_Acionada()
        RetVal="ESC"
EndIf
Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasPadrao()
private s

s=""
If IsAssigned(MSGCAMPO) 
   then if not isblank(MSGCAMPO)
           then
                if not isblank(TECLA)
                   then s=","+MSGCAMPO
                   else s=   MSGCAMPO
                EndIf
        endif
endif   

BarraPadrao()
    
Wait Field
  message s
  Until "ESC","ENTER",
        "HOME","UP","PGUP","DEL",
        -94,-33,-22, -18,
        "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12",-68,
        -104, -105, -106, -107, -108, -109, -110, -111, -112, -113, -133, -134, -139, -140
  
ClearSpeedBar      

IsTeclaAtalho()
Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasPadraoCF()
Private n,m

If Not IsAssigned(MODOFILTRARINCLUI) 
    Then MODOFILTRARINCLUI=True
EndIf        
    

Switch
  Case IsAssigned(MODOFILTRAR) And MODOFILTRAR:
    m = ""
    n = nrecords(table())
    
    Switch
      case n=0 : m="Modo filtro, sem registros"
      case n=1 : m="Modo Filtro, 1 registro"
      OtherWise: m="Modo Filtro, "+LTrim(Format("W10,EIC",n))+" registros"
    EndSwitch     
    BarraPadraoCF()
    
    While True
    
      Wait Field
       Message m
        Until "ESC","ENTER",
              "HOME","UP","PGUP","DEL",
              -94,-33,-22, -18, -68, 
              "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12",
              -104, -105, -106, -107, -108, -109, -110, -111, -112, -113, -133, -134, -139, -140
    
      If RetVal<>"ENTER"
         Then QuitLoop
         Else If MODOFILTRARINCLUI
                 Then QuitLoop 
                 Else FastMsg("Modo [FILTRO] inclusÆo nÆo permitida !")
                      CtrlBackSpace   
              EndIf           
      EndIf
    EndWhile
  
  OtherWise:
    BarraPadraoCF()
    
    Wait Field
      Until "ESC","ENTER",
            "HOME","UP","PGUP","DEL",
            -94,-33,-22, -18, -68,
            "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12",
            -104, -105, -106, -107, -108, -109, -110, -111, -112, -113, -133, -134, -139, -140
  
EndSwitch

ClearSpeedBar      

IsTeclaAtalho()
EndProc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasPadraoIt()

BarraPadraoIt()
Wait Field
  Until "ESC","ENTER",
        "HOME","UP","PGUP","PGDN",
        -94,-33,-115,-116,-133,-134,-145,-68,
        "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"
ClearSpeedBar      

Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasPadraoIt2()

BarraPadraoIt2()
Wait Field
  Until "ESC","ENTER",
        "HOME","UP","PGUP","PGDN",
        -94,-33,-115,-116,-133,-134,-68,
        "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"
ClearSpeedBar      

Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasPadraoIt3()
;Adicionado Message para Campo

BarraPadraoIt2()
Wait Field
  Message MSGCAMPO
  Until "ESC","ENTER",
        "HOME","UP","PGUP","PGDN",
        -94,-33,-115,-116,-133,-134,-68,
        "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"
ClearSpeedBar      

Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasDig()
If Not IsAssigned(TECLA)     Then TECLA    ="" EndIf
If Not IsAssigned(MSGCAMPO)  Then MSGCAMPO ="" EndIf

While True
  Prompt TECLA 
  Wait Field
    Until "ESC","ENTER",
          "HOME","END","PGUP","PGDN","DOWN","UP","INS","LEFT","RIGHT",
          -94,-33,-115,-116,-133,-134,-68,
          "DEL","FIELDVIEW","F35",
          "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"

  Switch
    Case Retval="FIELDVIEW" or Retval="F35": EDITFIELD()     
    Case Retval="LEFT"                     : EDITFIELD_LEFT()
    OtherWise                              : QuitLoop
  EndSwitch

EndWhile
        
Endproc

;*******************************************************************************
;* Rotina aguarda teclas padrao                                                *
;*******************************************************************************
Proc AguardaTeclasDig2()
If Not IsAssigned(TECLA)     Then TECLA    ="" EndIf
If Not IsAssigned(MSGCAMPO)  Then MSGCAMPO ="" EndIf

While True
  Prompt TECLA 
  Wait Field
   Message MSGCAMPO
    Until "ESC","ENTER",
          "HOME","END","PGUP","PGDN","DOWN","UP","INS","LEFT","RIGHT",
          -94,-33,-115,-116,-133,-134,-68,
          "DEL","FIELDVIEW","F35",
          "F1","F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12"

  Switch
    Case Retval="FIELDVIEW" or Retval="F35": EDITFIELD()     
    Case Retval="LEFT"                     : EDITFIELD_LEFT()
    OtherWise                              : QuitLoop
  EndSwitch

EndWhile
        
Endproc

;*******************************************************************************
;* Rotina monta codigo raiz referencia                                         *
;*******************************************************************************
Proc PegaCodigoRaiz(s)
Private s,ns

ns=s
Switch 
  Case SYS_CODIGO_CLIENTE="0239" Or 
       SYS_CODIGO_CLIENTE="0388" Or
       SYS_CODIGO_CLIENTE="0427" Or
       SYS_CODIGO_CLIENTE="0390" Or
       SYS_CODIGO_CLIENTE="0396" Or
       SYS_CODIGO_CLIENTE="0397" Or
       SYS_CODIGO_CLIENTE="0408" Or
       SYS_CODIGO_CLIENTE="0419" Or
       SYS_CODIGO_CLIENTE="0426" Or
       SYS_CODIGO_CLIENTE="0429" Or
       SYS_CODIGO_CLIENTE="0444" Or
      (SYS_CODIGO_CLIENTE="0345" And Upper(SubStr(Directory(),1,1))<>"V") : 
       ns=Substr(s,1,6)+"0000"

  Case SYS_CODIGO_CLIENTE="0003" Or    ; Tricostura
       SYS_CODIGO_CLIENTE="0403"  :    ; Kenia Confe‡äes
       ns=SubStr(s,1,6)+"0000"

  Case SYS_CLIENTE_CONFEC="0185" Or    ;
       SYS_CLIENTE_CONFEC="0195" Or    ;
       SYS_CLIENTE_CONFEC="0196":      ;
       ns=SubStr(s,1,7)+"000"

  Case SYS_CLIENTE_CONFEC="0171":      ; PadrÆo Venus
       ns=SubStr(s,1,6)+"0000"

  Case SYS_CLIENTE_CONFEC="0222":      ; PadrÆo Lupus
       ns=SubStr(s,1,6)+"0000"

  Case SYS_CLIENTE_CONFEC="0200" Or    ;
       SYS_CLIENTE_CONFEC="0204" Or
       SYS_CODIGO_CLIENTE="0322" Or
       SYS_CODIGO_CLIENTE="0434" Or 
       SYS_CODIGO_CLIENTE="0423"  :
       ns=SubStr(s,1,8)+"00"

  Case SYS_CLIENTE_CONFEC="0079":     ; Isabela Garcia
       ns=SubStr(s,1,6)+"0000"

EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Rotina monta codigo raiz referencia com a Cor                               *
;*******************************************************************************
Proc PegaCodigoRaizCor(s)
Private s,ns

;Lembrar de incluir tamb‚m no PegaCodigoRaizAteCor()

ns=s
Switch 
  Case SYS_CODIGO_CLIENTE="0003":      ; Tricostura
       ns=SubStr(s,1,8)+"00"

  Case SYS_CLIENTE_CONFEC="0185" Or    ;
       SYS_CLIENTE_CONFEC="0195" Or    ;
       SYS_CLIENTE_CONFEC="0196":      ;
       ns=SubStr(s,1,9)+"0"

  Case SYS_CLIENTE_CONFEC="0171":      ; PadrÆo Venus
       ns=SubStr(s,1,8)+"00"

  Case SYS_CLIENTE_CONFEC="0222":      ; PadrÆo Lupus
       ns=SubStr(s,1,8)+"00"

  Case SYS_CLIENTE_CONFEC="0200" Or    
       SYS_CLIENTE_CONFEC="0204" Or
       SYS_CLIENTE_CONFEC="0391"  :    ;KBS
       ns=SubStr(s,1,8)+"00"

  Case SYS_CLIENTE_CONFEC="0079":     ; Isabela Garcia
       ns=substr(s,01,8)+"00"
EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Rotina monta codigo raiz referencia com a Cor                               *
;*******************************************************************************
Proc PegaCodigoRaizAteCor(s)
Private s,ns

ns=s
Switch 
  Case SYS_CODIGO_CLIENTE="0003":      ; Tricostura
       ns=SubStr(s,1,8)

  Case SYS_CLIENTE_CONFEC="0185" Or    
       SYS_CLIENTE_CONFEC="0195" Or    
       SYS_CLIENTE_CONFEC="0196":      
       ns=SubStr(s,1,9)

  Case SYS_CLIENTE_CONFEC="0171":      ; PadrÆo Venus
       ns=SubStr(s,1,8)

  Case SYS_CLIENTE_CONFEC="0222":      ; PadrÆo Lupus
       ns=SubStr(s,1,8)

  Case SYS_CLIENTE_CONFEC="0200" Or    
       SYS_CLIENTE_CONFEC="0204" Or
       SYS_CLIENTE_CONFEC="0391"  :    ;KBS
       ns=SubStr(s,1,8)

  Case SYS_CLIENTE_CONFEC="0079":     ; Isabela Garcia
       ns=substr(s,1,8)
EndSwitch

Return ns

Endproc ;PegaCodigoRaizAteCor()

;*******************************************************************************
;* Rotina monta novo codigo Acabado/Semi-Acabado                               *
;*******************************************************************************
Proc MudaCodigoPara(s,tipo)
Private s,ns,tipo

ns=s
Switch
  Case SYS_CLIENTE_CONFEC="0079":                 ; Isabela Garcia
       Switch
         Case Tipo="P" : ns="2"+SubStr(s,2,9)
         Case Tipo="S" : ns="3"+SubStr(s,2,9)
       EndSwitch

  Case SYS_CLIENTE_CONFEC="0171":                 ; Venus  
       Switch
         Case Tipo="P" : ns="1"+SubStr(s,2,9)
         Case Tipo="S" : ns="2"+SubStr(s,2,9)
       EndSwitch

  Case SYS_CLIENTE_CONFEC<>"":                    ; Outras confec‡äes
       Switch
         Case Tipo="P" : ns="02"+SubStr(s,3,8)
         Case Tipo="S" : ns="03"+SubStr(s,3,8)
       EndSwitch

EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Rotina monta nova descricao item sem texto do tamanho  /??                  *
;*******************************************************************************
Proc TiraTamanhoDescricaoItem(s)
Private s,ns

ns=s
Switch
  Case SYS_CLIENTE_CONFEC="0171":
       ns=Substr(s,1,SearchFrom("(",s,1)-1)
       If Len(ns)=0
          Then ns=s
       EndIf

 Case SYS_CLIENTE_CONFEC="0185" Or
      SYS_CLIENTE_CONFEC="0195" Or
      SYS_CLIENTE_CONFEC="0196" Or
      SYS_CODIGO_CLIENTE="0003" Or
      SYS_CLIENTE_CONFEC="0222" Or
      SYS_CLIENTE_CONFEC="0200" Or
      SYS_CLIENTE_CONFEC="0204" Or
      SYS_CLIENTE_CONFEC="0079":
      ns=Substr(s,1,27)

EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Rotina monta nova descricao item sem texto da Cor/tamanho  /??              *
;*******************************************************************************
Proc TiraCorTamanhoDescricaoItem(s)
Private s,ns

ns=s
Switch
  Case SYS_CLIENTE_CONFEC="0171":
       ns=Substr(s,1,SearchFrom("(",s,1)-1)
       If Len(ns)=0
          Then ns=s
       EndIf

 Case SYS_CLIENTE_CONFEC="0185" Or
      SYS_CLIENTE_CONFEC="0195" Or
      SYS_CLIENTE_CONFEC="0196" Or
      SYS_CODIGO_CLIENTE="0003" Or
      SYS_CLIENTE_CONFEC="0222" Or
      SYS_CLIENTE_CONFEC="0200" Or
      SYS_CLIENTE_CONFEC="0204" Or
      SYS_CLIENTE_CONFEC="0079":
      ns=Substr(s,1,23)

EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Rotina retorna campos do tamnaho no codigo do item                          *
;*******************************************************************************
Proc PegaCampoTamanho(s)
Private s,ns

ns="0"
Switch 
  Case SYS_CLIENTE_CONFEC="0185" Or    ;
       SYS_CLIENTE_CONFEC="0195" Or    ;
       SYS_CLIENTE_CONFEC="0196":      ;
       ns=SubStr(s,10,1)

  Case SYS_CLIENTE_CONFEC="0171":      ; PadrÆo Venus
       ns=SubStr(s,9,2)

  Case SYS_CODIGO_CLIENTE="0003":      ; Tricostura  
       ns=SubStr(s,9,2)

  Case SYS_CLIENTE_CONFEC="0222":      ; PadrÆo Lupus
       ns=SubStr(s,9,2)

  Case SYS_CLIENTE_CONFEC="0200" Or    ;
       SYS_CLIENTE_CONFEC="0204":
       ns=SubStr(s,9,2)

  Case SYS_CLIENTE_CONFEC="0079":                 ; Isabela Garcia
       ns=SubStr(s,9,2)

EndSwitch

Return ns
Endproc

;*******************************************************************************
;* Reagrupa o Grupo do Report de acordo com o informado afim de ordena‡Æo      *
;*******************************************************************************
Proc Seta_Ordem_Report(Tabela,NReport,Campo_ORIG,Campo_Novo,Ordem)
Private Tabela, NReport, Campo_ORIG, Campo_Novo, Ordem

;Tabela         = Tabela temporaria
;NReport        = Numero do Report (Ex: "8","R")
;Campo_ORIG     = Campo Original do Report
;Campo_Novo     = Campo a Ser Modificado para a ImpressÆo
;Ordem          = Ascendente/Descendente = Se ‚ forma Descendente, informe "D", senÆo, em branco, manter  a padrÆo Ascendente

Campo_Novo="{"+Campo_Novo+"}"

{Report} {Change} TypeIn Tabela Enter TypeIn NReport Enter Enter

While True  
  Linha=CursorLine()
  If Search("group ",Linha)>0  
     Then PosIni=SearchFrom("group ",Linha,1)
          Linha=Substr(Linha,PosIni+6,Len(Linha))
          If Search(chr(196),Linha)>0
             Then PosFim=SearchFrom(chr(196),Linha,1)
                  Linha=Substr(Linha,1,PosFim-1)
                  If Linha = Campo_ORIG
                     Then {Group} {Regroup} Enter {Field} Execute Campo_Novo
                          If Ordem="D"
                             Then {Group} {SortDirection} Enter {Descending}
                             Else {Group} {SortDirection} Enter {Ascending}
                          EndIf   
                          Do_It!
                          ClearAll
                          QuitLoop
                  EndIf 
          EndIf 
  EndIf         
  Down   
  If Search(chr(30)+"page",Linha)>0  
     Then Do_It!
          ClearAll
          QuitLoop
  EndIf   
EndWhile

EndProc ; Seta_Ordem_Report()

;*******************************************************************************
;* Define altura/numero de linhas do report                                    *
;*******************************************************************************
Proc Seta_Altura_Report(Tabela,NReport,altura)
Private Tabela, NReport, altura

;Tabela         = Tabela temporaria
;NReport        = Numero do Report (Ex: "8","R")
;altura         = altura  n£mero de linhas

{Report} {Change} TypeIn Tabela Enter TypeIn NReport Enter Enter
Menu {Setting} {PageLayout} {Length} typein altura  Enter
Do_it!

EndProc ; Seta_Altura_Report()

;*******************************************************************************
;* Ordernar campo                                                              *
;*******************************************************************************
Proc OrdenaCampo(ncampo)
Moveto Field ncampo

Menu {Image} {OrderTable} Enter 

While True

  If Upper(MenuChoice())=Upper(ncampo)
    Then QuitLoop
    Else Down
  EndIf   

EndWhile
Enter 
If MenuChoice()="Cancel"
  Then {OK}
EndIf   

EndProc

;*******************************************************************************
;* Criar tabela de controle para filtro                                        *
;*******************************************************************************
Proc CriaTabelaControle()
                                   
If TabelaTemp=""
   Then TabelaTemp=Cria_Temp(PrivDir())
        Switch
          Case TabelaPrincipal = "Occ" :
               Copy "\\Base\\Sistemas\\Compras\\"+TabelaPrincipal TabelaTemp
          Case TabelaPrincipal = "Notaec" :
               Copy "\\Base\\Sistemas\\Estoque\\"+TabelaPrincipal TabelaTemp
          Case TabelaPrincipal = "RqCabeca" :
               Copy "\\Base\\Sistemas\\Estoque\\"+TabelaPrincipal TabelaTemp
          Case TabelaPrincipal = "MovCont" :
               Copy "\\Base\\Sistemas\\CtaCor\\"+TabelaPrincipal TabelaTemp
          Case TabelaPrincipal = "ChequeI" :
               Copy "\\Base\\Sistemas\\Cheqrec\\"+TabelaPrincipal TabelaTemp
          Case TabelaPrincipal = "FaturaC" :
               Copy "\\Base\\Sistemas\\Vendas\\"+TabelaPrincipal TabelaTemp     
        EndSwitch
EndIf        
Empty(TabelaTemp)
Add "Answer" TabelaTemp
TabelaControle=TabelaTemp

EndProc

;*******************************************************************************
;* deleta tabela de controle para filtro                                       *
;*******************************************************************************
Proc DeletaTabelaControle()
If IsTable(TabelaTemp) And Search("TEMP_",Upper(TabelaTemp))>0
   Then Delete TabelaTemp
EndIf   
EndProc

;*******************************************************************************
;* deleta tabela de controle para filtro                                       *
;*******************************************************************************
Proc CoEditaTabelaControle()

CoEdit TabelaControle
If ErrorCode()=4
   Then Do_It!
        ClearAll
        Release Vars All
        Release Procs All
        Return False
EndIf
If TabelaControle=TabelaPrincipal And NRecords(TabelaPrincipal)>1
   Then Home CtrlHome Right
        If IsBlank([])
           Then PickForm OPCAO_FORM
                Echo Normal
                Echo Off
                MSG="Existe registro com Erro !// //"
                MSG=MSG+"Verificar chave, campo="+Field()+" em branco !// //"
                MSG=MSG+"Use a fun‡Æo para navegar e visualize o primeiro registro da tabela !// //"
                MSG=MSG+"Delete este registro com erro, se nÆo conseguir contacte o suporte !"
                Mensagem(MSG)
        EndIf
EndIf

If Search("TEMP_",Upper(TabelaControle))>0
   Then {TableAdd} TypeIn TabelaPrincipal Enter
        Moveto TabelaControle
EndIf   
PickForm OPCAO_FORM

Return True
EndProc

;*******************************************************************************
;* Localiza e posiciona no regsitro da tabela principal                        *
;*******************************************************************************
Proc VerificaRegistroTemp(msg)
Private COD, RESULT, msg

COD    = ""
RESULT = True
If Not IsBlank([])
   Then COD = AlinhNL(COD,6)
        Del
        Locate COD
        If Not RetVal
           Then Mensagem(MSG)
                RESULT = False
           Else End Down
                [] = COD
        EndIf 
EndIf   

Return RESULT

EndProc ;VerificaRegistroTemp()

;*******************************************************************************
;* Localiza e posiciona no regsitro da tabela principal                        *
;*******************************************************************************
Proc PegaRegistroControle(campo,valor)
private campo,valor,result

;*****PARAMETRO*****
; * CAMPO 
; * VALOR DO CAMPO

result=true
STATUSFILTRO=""
If Search("TEMP_",Upper(TabelaControle))>0
   Then UnLockRecord
        FormKey
        Moveto TabelaPrincipal
        Moveto Field campo
        ;-------- Colocar o CASE da tabela e o Locate especifico -----------------------
        Switch
           Case TabelaPrincipal = "MovCont" :
                Locate valor,CONTA 

           Case TabelaPrincipal = "ChequeI" :
                Locate NLC,SLC 

           OtherWise :
                Locate valor
        EndSwitch
        If Not RetVal
           Then Mensagem("Registro nÆo localizado, atualize seu filtro !") 
                result=False
           Else If IsLockRecord()
                   Then result=False
                   Else STATUSFILTRO="UPDATE"
                EndIf   
        EndIf
EndIf   
If Not result
   Then Moveto TabelaControle
EndIf

release vars campo,valor
return result
EndProc

;*******************************************************************************
;* Localiza e posiciona no regsitro da tabela principal                        *
;*******************************************************************************
Proc AtualizaRegistroControle(campochave,valorchave,emmodopagina)
Private reg, campochave, valorchave, emmodopagina

;*****PARAMETRO*****
; * CAMPO 
; * VALOR DO CAMPO
; * SE E MODO PAGINAR OU NAO

If Search("TEMP_",Upper(TabelaControle))>0
   Then Switch
          Case Upper(STATUSFILTRO)="DEL":
               Formkey
               Moveto TabelaControle
               ;-------- Colocar o CASE da tabela e o Locate especifico --------
               Switch
                  Case TabelaPrincipal = "MovCont" :
                       Moveto Field campochave
                       If IsAssigned(CONTAG) And CONTAG<>""
                          Then Locate valorchave,CONTAG
                               If RetVal
                                  Then Del
                               EndIf
                       EndIf        
                       Locate valorchave,CONTA
                       If RetVal
                          Then Del
                       EndIf
                  
                  OtherWise :
                       Switch 
                         Case emmodopagina: 
                             Del
                         OtherWise      : 
                             If TabelaPrincipal = "FaturaC"           
                                Then If IsBlank([]) Then Del EndIf
                                     ;Dando erro de chave duplicada quando esta em branco o campo ao localizar o registro
                             EndIf
                             Moveto Field campochave
                             Locate valorchave
                             If RetVal
                                Then Del
                             EndIf
                       EndSwitch
               EndSwitch        
          Case Upper(STATUSFILTRO)="UPDATE":
               Formkey
               CopyToArray reg

               Moveto TabelaControle
               Switch 
                 Case emmodopagina: 
                      Moveto Field campochave
                      Locate valorchave
                      CopyFromArray reg
                      UnLockRecord
                      
                 OtherWise      :
                     Moveto Field campochave
                     switch
                       Case TabelaPrincipal = "ChequeI" :
                         Locate NLC,SLC
                       Otherwise:
                         Locate valorchave      
                     endswitch
                     If RetVal
                        Then CopyFromArray reg
                             UnLockRecord
                     EndIf
               EndSwitch
          Case Upper(STATUSFILTRO)="INSERT":
               UnLockRecord
               Formkey
               CopyToArray reg
               
               Moveto TabelaControle
               Locate valorchave
               If Not RetVal
                  Then End Down
               EndIf
               CopyFromArray reg
               UnLockRecord
          OtherWise:
               Formkey
               Moveto TabelaControle
        EndSwitch
EndIf   

STATUSFILTRO=""

Release vars reg, campochave, valorchave, emmodopagina
EndProc

;*******************************************************************************
;* Rotina para Gravar ExpressÆo em Arquivo                                     *
;*******************************************************************************
Proc GravaExpressao(VARIAVEL,TIPO,VALOR)
Private VARIAVEL,TIPO,VALOR,EXPRESSAO 

Switch
  Case Upper(TIPO)="T" : EXPRESSAO = ";"+VARIAVEL+"\n"
  Case Upper(TIPO)="S" : EXPRESSAO = VARIAVEL+"="+Chr(34)+StrVal(VALOR)+Chr(34)+"\n"
  Case Upper(TIPO)="N" : EXPRESSAO = VARIAVEL+"="+VALOR+"\n"
EndSwitch

Return EXPRESSAO

EndProc ;GravaExpressao()      

;*******************************************************************************
;* Rotina para Ler o Arquivo e Setar Vari veis                                 *
;*******************************************************************************
Proc LeiaINI(ARQUIVO,VARIAVEL)
Private ARQUIVO,VARIAVEL,TIPO,NVAR,CONTVAR,VAR_ARQUIVO,CONSULTA_ARQ,VR_VAR,
        TP_VAR,VAR_AUX,CONTARQ,CONTARQ1,CONTARQ2,PosI,PosF
        
; LeiaArq(Arquivo,Variavel)
; Sendo que o Arquivo, pode ser .INI, .TXT ou .SC e a variavel, pode ser setada mais de uma, para entÆo realizar a busca,
; no arquivo passado como parametro. A Variavel para ser analisada, devera ter o seu nome, o seu tipo e o seu valor default,
; com separa‡äes por ".", e caso haja mais de uma variavel, separar por ",".
; Ex: LeiaINI("RE_0010.ini","VSDGOPETIQUETA.S.1,VSDGOPRELCODALFDIG.S.1) 

; **** Verificando Quantas variaveis serÆo setadas *****************************
CONTVAR = 1
VAR_AUX = VARIAVEL
NVAR = Search(",",VAR_AUX)
While NVAR > 0 
  CONTVAR = CONTVAR + 1
  VAR_AUX = SubStr(VAR_AUX,NVAR+1,Len(VAR_AUX))
  NVAR = Search(",",VAR_AUX)
EndWhile
NVAR = CONTVAR

If NVAR = 0 
   Then Return 
EndIf
        
; **** Capturando o nome das variaveis *****************************************
Release Vars VAR_ARQUIVO 
DynArray VAR_ARQUIVO[]
For CONTARQ From 1 To NVAR
  PosI=SearchFrom(",",VARIAVEL,1)
  If PosI=0 
     Then VAR_ARQUIVO[CONTARQ]=SubStr(VARIAVEL,1,Len(VARIAVEL))
          QuitLoop 
  EndIf
  VAR_ARQUIVO[CONTARQ]=SubStr(VARIAVEL,1,PosI-1)
  If CONTARQ <> NVAR
     Then VARIAVEL = SubStr(VARIAVEL,PosI+1,Len(VARIAVEL))
  EndIf   
EndFor    

; **** Capturando o tipo das variaveis *****************************************
Release Vars NM_VAR,TP_VAR,VR_VAR
Array NM_VAR[NVAR]
Array TP_VAR[NVAR]
Array VR_VAR[NVAR]

For CONTARQ From 1 To NVAR
  ; *** Nome da Vari vel ***
  PosI=SearchFrom(".",VAR_ARQUIVO[CONTARQ],1)
  NM_VAR[CONTARQ]=SubStr(VAR_ARQUIVO[CONTARQ],1,PosI-1)
  VAR_ARQUIVO[CONTARQ]=SubStr(VAR_ARQUIVO[CONTARQ],PosI+1,Len(VAR_ARQUIVO[CONTARQ]))
  
  ; *** Tipo da Vari vel ***
  PosI=SearchFrom(".",VAR_ARQUIVO[CONTARQ],1)
  TP_VAR[CONTARQ]=SubStr(VAR_ARQUIVO[CONTARQ],1,PosI-1)
  VAR_ARQUIVO[CONTARQ]=SubStr(VAR_ARQUIVO[CONTARQ],PosI+1,Len(VAR_ARQUIVO[CONTARQ]))
  
  ; *** Valor Default da Var vel ***
  If Upper(VAR_ARQUIVO[CONTARQ])="NULL"
     Then Switch
            Case Upper(TP_VAR[CONTARQ])="N" : VAR_ARQUIVO[CONTARQ]=StrVal(BlankNum())
            Case Upper(TP_VAR[CONTARQ])="S" : VAR_ARQUIVO[CONTARQ]="" 
            Case Upper(TP_VAR[CONTARQ])="D" : VAR_ARQUIVO[CONTARQ]=StrVal(BlankDate()) 
          EndSwitch
  EndIf       
  VR_VAR[CONTARQ]=VAR_ARQUIVO[CONTARQ]
EndFor

If IsFile(ARQUIVO)
   Then FileRead ARQUIVO to Linha 
        
        ; **** Analisando linha a linha e a capturando p/ verifica‡Æo posterior
        CONTARQ=0
        DynArray CONSULTA_ARQ[]
        PosI=1
        While True
          CONTARQ = CONTARQ + 1
          PosF=SearchFrom("\n",Linha,PosI)
          If PosF=0 
             Then CONSULTA_ARQ[CONTARQ]=Substr(Linha,PosI,Len(Linha))
                  QuitLoop 
          EndIf
          CONSULTA_ARQ[CONTARQ]=Substr(Linha,PosI,(PosF-PosI))
          PosI=PosF+1
        EndWhile  
        
        ; **** Capturando os Valores das vari veis *****************************
        For CONTARQ1 From 1 To NVAR
          For CONTARQ2 From 1 To DynArraySize(CONSULTA_ARQ)
            PosI=SearchFrom(NM_VAR[CONTARQ1],CONSULTA_ARQ[CONTARQ2],1)
            If PosI=0 Then Loop EndIf
            VAR_AUX = SubStr(CONSULTA_ARQ[CONTARQ2],PosI+Len(NM_VAR[CONTARQ1]),Len(CONSULTA_ARQ[CONTARQ2])) 
            PosI=SearchFrom("=",VAR_AUX,1)
            Switch
              Case Upper(TP_VAR[CONTARQ1])="N" : If SubsTr(VAR_AUX,PosI+1,1)=Chr(34)
                                                    Then VAR_AUX = SubStr(VAR_AUX,PosI+2,Len(VAR_AUX))
                                                         PosF=SearchFrom(Chr(34),VAR_AUX,1)
                                                         VAR_AUX = SubStr(VAR_AUX,1,PosF-1)
                                                    Else VAR_AUX = SubStr(VAR_AUX,PosI+1,Len(VAR_AUX))
                                                EndIf
                                                
              Case Upper(TP_VAR[CONTARQ1])="D" : VAR_AUX = Tira_CharNum(SubStr(VAR_AUX,PosI+1,Len(VAR_AUX))) 
                                                 VAR_AUX = SubStr(VAR_AUX,1,2)+"."+
                                                           SubStr(VAR_AUX,3,2)+"."+
                                                           SubStr(VAR_AUX,5,4)
                                                    
              OtherWise                 : VAR_AUX = SubStr(VAR_AUX,PosI+1,Len(VAR_AUX)) 
            EndSwitch  
            If VAR_AUX<>""
               Then VR_VAR[CONTARQ1]=VAR_AUX
            EndIf   
          EndFor          
        EndFor   
EndIf   

For CONTARQ From 1 To NVAR 
  If IsBlank(VR_VAR[CONTARQ])
     Then Execute NM_VAR[CONTARQ]+"=\"\""                                       ;Setando Vari vel Vazia
     Else Execute NM_VAR[CONTARQ]+"="+VR_VAR[CONTARQ]
  EndIf   
Endfor

; *** Se o arquivo ¤ existir, as variaveis serÆo setadas com seus vr default ***

EndProc ;LeiaINI()   

;*******************************************************************************
;* Rotina para abrir e controlas janela da tabela                              *
;*******************************************************************************
Proc AbrirTabela(Tabela,Modo,r,c,h,w)
Private Tabela, Modo, Janela, r,c,h,w

Switch
  Case Modo="V"     :   View Tabela 
  Case Modo="VNW"   :   View NoWindow Tabela 
  Case Modo="E"     :   Edit Tabela 
  Case Modo="C"     : CoEdit Tabela 
  Case Modo="Add"   : {TableAdd} TypeIn Tabela Enter
  Case Modo="AddRO" : {TableAdd} TypeIn Tabela Enter ImageRights ReadOnly
EndSwitch
Janela=GetWindow()
Window Move   Janela To r,c
Window Resize Janela To h,w

Return Janela
EndProc ;AbrirTabela()

;*******************************************************************************
;* Rotina Cor do sistema                                                       *
;*******************************************************************************
Proc SetaCor_Sistema()
                                
;-- Cores do sistema -----------------------------------------------------------  
;SYS_COR=""
;SYS_COR="PRETO"        
;SYS_COR="AZUL"         
;SYS_COR="VERDE"        
;SYS_COR="CYAN"         
;SYS_COR="VERMELHO"     
;SYS_COR="MAGENTA"       
;SYS_COR="MARROM"        
;SYS_COR="BRANCO"
;SYS_COR="CINZA"
;SYS_COR="LIMAO"       
;SYS_COR="AMARELO"       

If IsBlank(SYS_COR)
   Then If Upper(SubStr(Directory(),1,1))="X" Or (IsAssigned(NOMEMPRESA) And Search("\*\*",NOMEMPRESA)>0)
           Then SYS_COR="VERMELHO"  
           Else SYS_COR="AZUL"
        EndIf
Endif
SYS_COR_FUNDO=135

Switch
  Case SYS_COR="PRETO"    : SYS_COR_RODAPE =15   SYS_COR_RODAPED=14    SYS_COR_MENUD=112  SYS_COR_LABELAT=10
                            SYS_COR_TEXTO  =7    SYS_COR_TEXTOS =15    SYS_COR_BTN  =8
                            
  Case SYS_COR="AZUL"     : SYS_COR_RODAPE =31   SYS_COR_RODAPED=30    SYS_COR_MENUD=121  SYS_COR_LABELAT=26
                            SYS_COR_TEXTO  =23   SYS_COR_TEXTOS =31    SYS_COR_BTN  =16
                            SYS_COR_FUNDO  =48 
                            
  Case SYS_COR="VERDE"    : SYS_COR_RODAPE =47   SYS_COR_RODAPED=46    SYS_COR_MENUD=114  SYS_COR_LABELAT=46
                            SYS_COR_TEXTO  =39   SYS_COR_TEXTOS =47    SYS_COR_BTN  =32
                            
  Case SYS_COR="CYAN"     : SYS_COR_RODAPE =63   SYS_COR_RODAPED=62    SYS_COR_MENUD=115  SYS_COR_LABELAT=58
                            SYS_COR_TEXTO  =55   SYS_COR_TEXTOS =63    SYS_COR_BTN  =48
                            
  Case SYS_COR="VERMELHO" : SYS_COR_RODAPE =79   SYS_COR_RODAPED=78    SYS_COR_MENUD=124  SYS_COR_LABELAT=74
                            SYS_COR_TEXTO  =71   SYS_COR_TEXTOS =79    SYS_COR_BTN  =64

  Case SYS_COR="MAGENTA"  : SYS_COR_RODAPE =95   SYS_COR_RODAPED=94    SYS_COR_MENUD=117  SYS_COR_LABELAT=94
                            SYS_COR_TEXTO  =87   SYS_COR_TEXTOS =95    SYS_COR_BTN  =80
  
  Case SYS_COR="MARROM"   : SYS_COR_RODAPE=111   SYS_COR_RODAPED=110   SYS_COR_MENUD=118  SYS_COR_LABELAT=106
                            SYS_COR_TEXTO =103   SYS_COR_TEXTOS =111   SYS_COR_BTN  =96
                            
  Case SYS_COR="BRANCO"   : SYS_COR_RODAPE=120   SYS_COR_RODAPED=116   SYS_COR_MENUD=120  SYS_COR_LABELAT=121
                            SYS_COR_TEXTO =120   SYS_COR_TEXTOS =112   SYS_COR_BTN  =112
                            
  Case SYS_COR="CINZA"    : SYS_COR_RODAPE =128  SYS_COR_RODAPED=142   SYS_COR_MENUD=121  SYS_COR_LABELAT=142
                            SYS_COR_TEXTO  =135  SYS_COR_TEXTOS=143    SYS_COR_BTN  =128

  Case SYS_COR="LIMAO"    : SYS_COR_RODAPE=160   SYS_COR_RODAPED=172   SYS_COR_MENUD=121  SYS_COR_LABELAT=172
                            SYS_COR_TEXTO =168   SYS_COR_TEXTOS =160   SYS_COR_BTN  =160
                            
  Case SYS_COR="AMARELO"  : SYS_COR_RODAPE=230   SYS_COR_RODAPED=237   SYS_COR_MENUD=121  SYS_COR_LABELAT=236
                            SYS_COR_TEXTO =229   SYS_COR_TEXTOS =230   SYS_COR_BTN  =229
EndSwitch

GetColors To cccolors

;Titulo
cccolors[1001]=SYS_COR_RODAPE 
cccolors[1003]=SYS_COR_RODAPED   

;Rodape
cccolors[1063]=SYS_COR_RODAPED 
cccolors[1065]=SYS_COR_RODAPE   
cccolors[1066]=SYS_COR_RODAPE     
cccolors[1068]=SYS_COR_RODAPE     
cccolors[1069]=SYS_COR_RODAPE     
cccolors[1071]=SYS_COR_RODAPE     


;SetColors From cccolors 
;release vars cccolors
;return

;ShowDialog
cccolors[1031]=SYS_COR_TEXTO      ;frame inativo 
cccolors[1032]=SYS_COR_TEXTOS     ;frame atibvo  
cccolors[1033]=SYS_COR_RODAPED    ;close

cccolors[1034]=SYS_COR_RODAPE     ;barra         
cccolors[1035]=SYS_COR_RODAPE     ;barra controle

cccolors[1036]=SYS_COR_TEXTO      ;fundo       
cccolors[1037]=SYS_COR_TEXTO      ;label

cccolors[1038]=SYS_COR_LABELAT    ;label cursor
cccolors[1039]=SYS_COR_RODAPED    ;label letra atalho

cccolors[1046]=SYS_COR_TEXTO      ; check box/radio button
cccolors[1047]=SYS_COR_TEXTOS     ; check box/radio button cursor
cccolors[1048]=SYS_COR_RODAPED    ; check box/radio button letra atalho

cccolors[1049]=112                ; Cor PadrÆo TypeInBox
cccolors[1050]=47                 ; Cor PadrÆo TypeInBox Selecionado
cccolors[1051]=112                ; Cor PadrÆo TypeInBox Arrows

Switch
  Case SYS_COR="PRETO"    : cccolors[1045]=8                  ;sombra botao        
  Case SYS_COR="AZUL"     : cccolors[1045]=SYS_COR_BTN
  Case SYS_COR="VERDE"    : cccolors[1045]=32
  Case SYS_COR="CYAN"     : cccolors[1045]=48
  Case SYS_COR="VERMELHO" : cccolors[1045]=64
  Case SYS_COR="MAGENTA"  : cccolors[1045]=80
  Case SYS_COR="MARROM"   : cccolors[1045]=96
  Case SYS_COR="BRANCO"   : cccolors[1045]=112
                            cccolors[1049]=135
                            cccolors[1050]=135
                            cccolors[1051]=135
  Case SYS_COR="CINZA"    : cccolors[1045]=SYS_COR_BTN
  Case SYS_COR="LIMAO"    : cccolors[1045]=160
  Case SYS_COR="AMARELO"  : cccolors[1045]=224
EndSwitch

If SYS_COR="VERMELHO" 
   Then cccolors[1057] =31    ;COR LINHA SELECIONADA DO SHOWDIALOG   
        ;A posi‡Æo [1058] ‚ controlada no "Menupri", e fica apenas uma cor independente da paleta que estiver sendo aplicada
        ;Esta posi‡Æo ‚ para quando a linha FOI selecionada e nÆo esta mais com o foco em cima dela 
EndIf

SetColors From cccolors 
release vars cccolors

EndProc  ; (SetaCor_Sistema)

;*******************************************************************************
;* Rotina Setar Cor do Sistema (Splash)                                        *
;*******************************************************************************
Proc Cor_Splash()

corluz   =25
corsombra=16
corvise  =31
cordados =112

Switch
  Case SYS_COR="PRETO"    :    
    corluz   =7
    corsombra=8
    corvise  =15
    cordados =7     
  Case SYS_COR="AZUL"     : 
    corluz   =25
    corsombra=16
    corvise  =31
    cordados =23
  Case SYS_COR="VERDE"    : 
    corluz   =42
    corsombra=32
    corvise  =47
    cordados =39
  Case SYS_COR="CYAN"     : 
    corluz   =58
    corsombra=48
    corvise  =63
    cordados =55
  Case SYS_COR="VERMELHO" : 
    corluz   =76
    corsombra=64
    corvise  =79
    cordados =71 
  Case SYS_COR="MAGENTA"  :  
    corluz   =93
    corsombra=80
    corvise  =95
    cordados =87
  Case SYS_COR="MARROM"   : 
    corluz   =110
    corsombra=96
    corvise  =111
    cordados =103
  Case SYS_COR="BRANCO"   : 
    corluz   =120
    corsombra=112
    corvise  =112
    cordados =120
  Case SYS_COR="CINZA"    : 
    corluz   =135
    corsombra=128
    corvise  =143
    cordados =135 
  Case SYS_COR="LIMAO"    : 
    corluz   =162
    corsombra=160
    corvise  =168
    cordados =168
  Case SYS_COR="AMARELO"  :
    corluz   =230
    corsombra=224
    corvise  =232
    cordados =232 
EndSwitch

EndProc ;Cor_Splash()

;******************************************************************************
;** Atribui Valor Variaveis Principais                                      ***
;******************************************************************************
Proc SYS_Valor()

If IsAssigned(SYS_CLIENTE_CONFEC) 
   Then If SYS_CLIENTE_CONFEC<>"" 
           Then Return
        EndIf   
EndIf

If IsAssigned(SYS_CODIGO_CLIENTE) 
   Then If SYS_CODIGO_CLIENTE<>"" 
           Then Return
        EndIf   
EndIf

Password "FechaSys"
View "\\Sistemas\\Cadastro\\SysTable"
SYS_CODIGO_CLIENTE = [Codigo do Cliente       ]
SYS_CLIENTE_CONFEC = [Codigo_Cliente_Confeccao]
ClearImage

EndProc ;SYS_Valor()

;******************************************************************************
;** Verifica Data na SysTable                                               ***
;******************************************************************************
Proc SYS_DATA()

Password "FechaSys"
View "\\Sistemas\\Cadastro\\SysTable"
SYSTABLE_DT_ATUAL = DateVal(SubStr([Versao_Atual],11,10))
ClearAll

If Type(SYSTABLE_DT_ATUAL)<>"D"
   Then SYSTABLE_DT_ATUAL=BlankDate()
EndIF   

EndProc ;SYS_DATA()     

;*******************************************************************************
;* Rotina para gerar proximo lancamento                                        *
;*******************************************************************************
Proc ProximaOrdem(CAMPO)
Private i,CAMPO,NLANCTO

For i From 1 to 10
  Moveto Field CAMPO
  End
  If IsBlank([])
     Then NLANCTO="1"
     Else NLANCTO=StrVal(NumVal([])+1)
  EndIf
  NLANCTO=AlinhM(NLANCTO,6)
  Down
  Moveto Field CAMPO
  []=NLANCTO
  PostRecord KeyViol LeaveLocked
  If RetVal     
     Then Return True
     Else Del
  EndIf    
EndFor

Return False

EndProc ;ProximaOrdem()

;*******************************************************************************
;* Rotina Menu Filtrar                                                         *
;*******************************************************************************            
Proc MenuFiltrar()

If MODOFILTRARATIVO
   Then 
        FileWrite        PrivDir()+"mf.sc" From "Echo Normal"+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "Echo Off"+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "ShowPopup \" Fun‡”es \" CENTERED"+"\n"

        If (Not MODOFILTRAR And MODOFILTRARATIVO) Or
           (MODOFILTRAR And MODOFILTRARATIVO)
           Then FileWrite Append PrivDir()+"mf.sc" From "\"~F~iltrar\" : \" Ativar crit‚rio de filtro para edicao\" : \"MENUFILTRAR\", "+"\n"  
        EndIf
        If MODOFILTRAR And MODOFILTRARATIVO And REGRAFILTRO<>""
           Then FileWrite Append PrivDir()+"mf.sc" From "\"Filtro/~P~adrÆo\" : \" Monta filtro padrÆo\" : \"MENUFILTROPADRAO\", "+"\n"
        EndIf
        If MODOFILTRAR And MODOFILTRATODOS
           Then FileWrite Append PrivDir()+"mf.sc" From "\"~T~odos\" : \" Desativar filtro e exiber todos registros\" : \"MENUFILTROTODOS\", "+"\n"
        EndIf  
   
        If IsAssigned(MfOpcao)
           Then For i From 1 To ArraySize(MfOpcao)
                  FileWrite Append PrivDir()+"mf.sc" From MfOpcao[i]+", "+"\n"
                EndFor
        EndIf
        
        FileWrite Append PrivDir()+"mf.sc" From "Separator, "+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "\"~S~air\" : \" Ignorar op‡äes\"   : \"CANCELAR\""+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "EndMenu"+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "To MenuVar"+"\n"
        FileWrite Append PrivDir()+"mf.sc" From "Echo Off"
        
        Play PrivDir()+"mf"

        FileWrite PrivDir()+"mf.sc" From ""

        Return MenuVar
   Else FastMsg("Sem Filtro !")
        Return ""
EndIf    

EndProc ;MenuFiltrar()        

;******************************************************************************
;*  Rotina para Excluir Arquivos conforme parƒmetros                          *
;******************************************************************************
Proc Excluir_Arquivo(DIRETORIO,INICIO_SENTENCA,EXTENSAO)
Private DIRETORIO,INICIO_SENTENCA,EXTENSAO, EXC

;---- Fun‡Æo utilizando o Run do DOS ao inv‚s do ExecVise ----------------------
;DIRETORIO        -> O Diretorio dever  ser informado e v lido.
;INICIO_SENTENCA  -> O Inicio do nome do arquivo a ser excluido pode ser em branco, um ou v rios, usando a virgula como o separador  
;EXTENSAO         -> A extensÆo do arquivo a ser excluido pode ser em branco, uma ou v rias, usando a virgula como o separador 

If DIRETORIO="" Or DirExists(DIRETORIO)=0
   Then Mensagem("Imposs¡vel utilizar a rotina de exclus„o!////DIRETORIO NAO INFORMADO OU NAO EXISTE!//Verificar com o Suporte T‚cnico da VISE INFORMATICA!")
        Return False
EndIf   

If INICIO_SENTENCA="" And EXTENSAO=""
   Then Mensagem("Imposs¡vel utilizar a rotina de exclus„o!////PARAMETROS INCORRETOS!//Verificar com o Suporte T‚cnico da VISE INFORMATICA!")
        Return False
EndIf   

If IsFile(PrivDir()+"funcmd.bat")
   Then Deleta_Arquivo(PrivDir()+"funcmd.bat")
        Sleep 1000
EndIf   

CONT_SENT = 0
DynArray ARRAY_SENT[]
If INICIO_SENTENCA<>""
   Then PosI = Search(",",INICIO_SENTENCA)
        While PosI >0
          AUX_INICIO = SubStr(INICIO_SENTENCA,1,PosI-1)
          INICIO_SENTENCA = SubStr(INICIO_SENTENCA,PosI+1,Len(INICIO_SENTENCA))
          
          CONT_SENT = CONT_SENT + 1
          ARRAY_SENT[CONT_SENT] = "Del "+DIRETORIO+AUX_INICIO+"*."
          
          PosI = Search(",",INICIO_SENTENCA) 
        EndWhile
        If PosI=0 And Rtrim(INICIO_SENTENCA)<>""
           Then CONT_SENT = CONT_SENT + 1
                ARRAY_SENT[CONT_SENT] = "Del "+DIRETORIO+INICIO_SENTENCA+"*."
        EndIf
   Else CONT_SENT = CONT_SENT + 1
        ARRAY_SENT[CONT_SENT] = "Del "+DIRETORIO+"*."      
EndIf        
        
CONT_EXT = 0
DynArray ARRAY_EXT[]        
If EXTENSAO<>""
   Then PosI = Search(",",EXTENSAO)
        While PosI > 0
          AUX_EXT = SubStr(EXTENSAO,1,PosI-1)
          EXTENSAO = SubStr(EXTENSAO,PosI+1,Len(EXTENSAO))
          For i From 1 To DynArraySize(ARRAY_SENT)
            CONT_EXT = CONT_EXT + 1
            ARRAY_EXT[CONT_EXT] = ARRAY_SENT[i]+AUX_EXT
          EndFor
          PosI = Search(",",EXTENSAO)       
        EndWhile
        If PosI=0 And Rtrim(EXTENSAO)<>""
           Then For i From 1 To DynArraySize(ARRAY_SENT)
                  CONT_EXT = CONT_EXT + 1
                  ARRAY_EXT[CONT_EXT] = ARRAY_SENT[i]+EXTENSAO
               EndFor 
        EndIf
   Else For i From 1 To DynArraySize(ARRAY_SENT)
          CONT_EXT = CONT_EXT + 1
          ARRAY_EXT[CONT_EXT] = ARRAY_SENT[i]+"*"
        EndFor      
EndIf 

ARQIMP = "C:"+"\n"

For i From 1 To DynArraySize(ARRAY_EXT)
 ARQIMP = ARQIMP + ARRAY_EXT[i] + "\n"
EndFor   

Aguarde("Aguarde, excluindo arquivos temporarios")
FileWrite PrivDir()+"funcmd.bat" From ARQIMP+"\n"
Run NoRefresh PrivDir()+"funcmd.bat"
Sleep 1000

Release Vars INICIO_SENTENCA,EXTENSAO, EXC

Return True

EndProc ;Excluir_Arquivo()   

;******************************************************************************
;** Monta Procedures                                                        ***
;******************************************************************************
Proc Abrir_Arquivo(ARQIMP)
Private ARQIMP

If IsFile(PrivDir()+"funcmd.bat")
   Then Deleta_Arquivo(PrivDir()+"funcmd.bat")
        Sleep 1000
EndIf   

ARQIMP = "Start "+ARQIMP

FileWrite PrivDir()+"funcmd.bat" From ARQIMP+"\n"
ExecVise("CMD "+PrivDir()+"funcmd.bat")
Sleep 1000

EndProc ;Abrir_Arquivo()   

;******************************************************************************
;** Rotina p/ Verificar Data de Emissao/Saida                               ***
;******************************************************************************
Proc Verifica_Emissao_Saida(PARAM)
Private Aux_Data,MESTRANSICAO,PARAM,ANOTRANSICAO,MESPARAM,ANOPARAM

;---- Liberado em 11.2015 foi disponibilizado apenas para determinada(s) empresa(s) a ativa‡Æo
;     da regra para controle do estoque, em 12.2015, esta verifica‡Æo estar  dispon¡vel
;     para todas as empresas. Caso haja empresas h  atualizar em 01.2016, haver  a 
;     necessidade de incluir a mesma no Switch abaixo, setando o SYS_CODIGO_CLIENTE

;---- Mˆs da Transi‡Æo ---------------------------------------------------------
MESTRANSICAO = "12"
ANOTRANSICAO = "2015"

ANOPARAM = StrVal(Year(PARAM))
MESPARAM = AlinhM(StrVal(Month(PARAM)),2)

REGRA_DATA_ESTOQUE = "Antiga"
CONT_REGRA         = 1 

If Not IsAssigned(SYS_CODIGO_CLIENTE) Or SYS_CODIGO_CLIENTE=""
   Then Return False
EndIf      

Switch
  Case SYS_CODIGO_CLIENTE = "0318"  : MESTRANSICAO = "11"
                                      ANOTRANSICAO = "2015"
  Case SYS_CODIGO_CLIENTE = "XXXX" Or
       SYS_CODIGO_CLIENTE = "YYYY"  : MESTRANSICAO = "01"
                                      ANOTRANSICAO = "2016"
EndSwitch                                                                              

Switch
  Case MESPARAM = MESTRANSICAO And 
       ANOPARAM = ANOTRANSICAO   : REGRA_DATA_ESTOQUE = "Transicao"
       
  Case MESPARAM < MESTRANSICAO And
       ANOPARAM = ANOTRANSICAO   : REGRA_DATA_ESTOQUE = "Antiga"
       
  Case MESPARAM > MESTRANSICAO And  
       ANOPARAM = ANOTRANSICAO   : REGRA_DATA_ESTOQUE = "Nova"
       
  Case ANOPARAM < ANOTRANSICAO   : REGRA_DATA_ESTOQUE = "Antiga"
  
  Case ANOPARAM > ANOTRANSICAO   : REGRA_DATA_ESTOQUE = "Nova"   
  
  OtherWise                      : REGRA_DATA_ESTOQUE = "Nova"
EndSwitch  

If Not IsAssigned(REGRA_DATA_ESTOQUE) Or
   (REGRA_DATA_ESTOQUE<>"Antiga" And REGRA_DATA_ESTOQUE<>"Transicao" And REGRA_DATA_ESTOQUE<>"Nova")
   Then Mensagem("N„o foi poss¡vel localizar a REGRA p/ verifica‡„o da//"+
                 "data de opera‡„o referente ao controle do estoque!  ")
        Return False 
EndIf

If REGRA_DATA_ESTOQUE = "Transicao" 
   Then CONT_REGRA = 2
   Else CONT_REGRA = 1
EndIf   

Return True
     
EndProc ;Verifica_Emissao_Saida()

;******************************************************************************
;** Rotina p/ Identificar Mˆs e o Ano de um determinado per¡odo             ***
;******************************************************************************
Proc Identifica_MesAno_Periodo(DATAINI,DATAFIM)
Private CONTADOR,AUX_DATA,AUX_MES,AUX_ANO,AUX_DIA,DATAINI,DATAFIM
          
;� setado um array MESANO_DTINI[] informando a data inicial de cada mˆs deste intervalo passado como parƒmetro
;� setado um array MESANO_DTFIM[] informando a data final de cada mˆs deste intervalo passado como parƒmetro 

Switch
  Case SubStr(DATAINI,1,1)="E" : Mensagem("Data inicial ‚ inv lida!")
  Case SubStr(DATAFIM,1,1)="E" : Mensagem("Data final ‚ inv lida!")
EndSwitch
If SubStr(DATAINI,1,1)="E"  Or SubStr(DATAFIM,1,1)="E"
   Then Return
EndIf   

If Month(DATAINI) = Month(DATAFIM) And Year(DATAINI) = Year(DATAFIM)
   Then Array MESANO_DTINI[1]
        Array MESANO_DTFIM[1]
        MESANO_DTINI[1]=DATAINI
        MESANO_DTFIM[1]=DATAFIM
   Else CONTADOR = 0
        AUX_DATA = DATAINI
        While True
          CONTADOR = CONTADOR + 1
          AUX_MES  = Month(AUX_DATA)
          AUX_ANO  = Year(AUX_DATA)
          
          If AUX_MES = Month(DATAFIM) And AUX_ANO = Year(DATAFIM)
             Then QuitLoop
          EndIf
              
          AUX_MES  = AlinhM(StrVal(Month(AUX_DATA)+1),2)
          AUX_ANO  = AlinhM(StrVal(Year(AUX_DATA)),4)
          If NumVal(AUX_MES)=13
             Then AUX_MES = "01"
                  AUX_ANO = StrVal(Year(AUX_DATA)+1)
          EndIf    
          AUX_DATA = "01"+"."+AUX_MES+"."+AUX_ANO
          AUX_DATA = DateVal(AUX_DATA)
        EndWhile
        
        Array MESANO_DTINI[CONTADOR]
        Array MESANO_DTFIM[CONTADOR]
        
        CONTADOR=0
        AUX_DATA = DATAINI
        While True
          CONTADOR = CONTADOR + 1
          MESANO_DTINI[CONTADOR] = AUX_DATA
          
          AUX_MES  = Month(AUX_DATA)
          AUX_ANO  = Year(AUX_DATA)
                
          If ArraySize(MESANO_DTFIM)=CONTADOR
             Then MESANO_DTFIM[CONTADOR]=DATAFIM
                  QuitLoop
             Else MESANO_DTFIM[CONTADOR]=Ultimo_Dia_Data(MESANO_DTINI[CONTADOR])     
          EndIf   
          
          AUX_MES  = AlinhM(StrVal(Month(AUX_DATA)+1),2)
          AUX_ANO  = AlinhM(StrVal(Year(AUX_DATA)),4)
          If NumVal(AUX_MES)=13
             Then AUX_MES = "01"
                  AUX_ANO = StrVal(Year(AUX_DATA)+1)
          EndIf

          If Len(AUX_DATA)=9
             Then AUX_DIA = "0"+SubStr(AUX_DATA,1,1)
             Else AUX_DIA = SubStr(AUX_DATA,1,2) 
          EndIf

          If CONTADOR = 1 And ArraySize(MESANO_DTINI)<>CONTADOR
             Then AUX_DIA="01"   
          EndIf
          AUX_DATA = AUX_DIA+"."+AUX_MES+"."+AUX_ANO
          AUX_DATA = DateVal(AUX_DATA)
        EndWhile
EndIf     

EndProc ;Identifica_MesAno_Periodo()

;*******************************************************************************
;* Rotina para Localizar Item                                                  *
;*******************************************************************************
Proc ModoLocalizarItem(tipo, valor, origem)
private tipo, valor, origem
;tipo   = SELECAO, LOCALIZAR, em branco ‚ pra Setar
;valor  = valor a ser localizado
;origem = nome do script a salvar configura‡Æo

If Not IsAssigned(LOC_RETORNO_CODITEM) Then LOC_RETORNO_CODITEM = False EndIf
switch

  ;-- Localizar item -------------------------------------------------------------
  case tipo="LOCALIZAR":
    Switch
      Case LOCALIZA_CODIGO="LOC_CODFOR" :
           Moveto [Codigo Fornecedor]
           Locate valor

      Case LOCALIZA_CODIGO="LOC_CODREF" :
           Moveto [Referencia]
           Locate valor

      Case LOCALIZA_CODIGO="LOC_CODBAR" :
           Moveto [Codigo de Barras]
           Locate IndexOrder by "cod_barras" valor
           If Not RetVal
              Then If Codigo_Barras2(valor,"S")
                   Then valor = CODIGO_BARRA2
                   Else valor = ""
                EndIf
                Moveto [Codigo do Item]
                Locate valor
           EndIf
      otherwise:
           Moveto [Codigo do Item]
           If Len(valor)<=10
              Then Locate ALINHM(valor,10)
              Else Locate valor
           EndIf
    EndSwitch
    
    LOC_CODIGO_ITEM    = ""
    LOC_DESCRICAO_ITEM = ""
    If LOC_RETORNO_CODITEM
       Then If RetVal
               Then LOC_CODIGO_ITEM    = [Codigo do Item]
                    LOC_DESCRICAO_ITEM = [Descricao do Item]
                    KeyPress "ESC"
               Else KeyPress "ESC"
            EndIf
    EndIf
    Return

  ;-- Selecionado modo localizar -------------------------------------------------
  Case tipo="SELECAO":
    LimpaRodape(0)
    ShowPopup " Modo Localizar o Item por " CENTERED
      "C¢digo do ~I~tem               " : " Localiza o item pelo seu c¢digo                  " : "LOC_CODITE",
      "C¢digo do Item do ~F~ornecedor " : " Localiza o item pelo c¢digo do item do fornecedor" : "LOC_CODFOR",
      "~R~eferˆncia do Item           " : " Localiza o item pela sua referˆncia              " : "LOC_CODREF",
      "C¢digo de ~B~arras             " : " Localiza o item pelo c¢digo de barras            " : "LOC_CODBAR",
      Separator,
      "~S~alvar Modo                  " : " Salvar Modo Localizar para a Esta‡Æo de Trabalho " : "SALVAR",
      Separator,
      "~C~ancelar                     " : " Ignorar a Opera‡„o                               " : "CANCELAR"
    EndMenu
    To MenuVar
    Echo Off

    If MenuVar="CANCELAR" or MenuVar="Esc"
        Then return
    endif
    RetVal=MenuVar

    ;-- Salvando configura‡Æo --------------------------------------------------
    If MenuVar="SALVAR"
        Then
             origem=PrivDir()+origem+".ini"
             FileWrite origem From GravaExpressao("LOCALIZA_CODIGO","S",LOCALIZA_CODIGO)

             fastmsg("Salvando configura‡Æo em "+origem+" !")
             return
    endif

    LOCALIZA_CODIGO = MenuVar

endswitch

;-- Definindo qual localizar_por -----------------------------------------------
Switch
  Case LOCALIZA_CODIGO="LOC_CODFOR" : LOCALIZAR_POR="C¢d item Fornecedor"
  Case LOCALIZA_CODIGO="LOC_CODREF" : LOCALIZAR_POR="Referˆncia"
  Case LOCALIZA_CODIGO="LOC_CODBAR" : LOCALIZAR_POR="C¢digo Barras"
  otherwise:
       LOCALIZA_CODIGO="LOC_CODITE"   LOCALIZAR_POR="C¢digo Item"
EndSwitch

EndProc ;ModoLocalizarItem() 

;*******************************************************************************
;* Rotina para verificar o item a ser localizado                               *
;*******************************************************************************
Proc Item_Localizador(CODIGO_ITEM) 
Private CODIGO_ITEM,REG_ITEM,ANT_CODIGO_ITEM
        
ANT_CODIGO_ITEM = CODIGO_ITEM

If LOCALIZA_CODIGO = "LOC_CODITE" 
   Then If Len(CODIGO_ITEM)<10
           Then CODIGO_ITEM = AlinhM(CODIGO_ITEM,10) 
        EndIf
EndIf    

;Comentado em 30/05/2018 por nÆo saber precisamente qual a finalidade deste codigo, pois analisando junto a Anivel, 
;nÆo tem motivos dessa implementa‡Æo.
;If Len(CODIGO_ITEM)=10
;   Then GetRecord "\\Sistemas\\Estoque\\Itens" CODIGO_ITEM To REG_ITEM
;        If RetVal
;           Then If LOCALIZA_CODIGO <> "LOC_CODITE"
;                   Then Switch
;                          Case LOCALIZA_CODIGO = "LOC_CODFOR" : CODIGO_ITEM = REG_ITEM["Codigo Fornecedor"]
;                          Case LOCALIZA_CODIGO = "LOC_CODREF" : CODIGO_ITEM = REG_ITEM["Referencia"]
;                          Case LOCALIZA_CODIGO = "LOC_CODBAR" : CODIGO_ITEM = REG_ITEM["Codigo de Barras"] 
;                        EndSwitch
;                        If CODIGO_ITEM = ""
;                           Then CODIGO_ITEM = ANT_CODIGO_ITEM
;                        EndIf   
;                EndIf            
;        EndIf
;EndIf

Return CODIGO_ITEM

EndProc ;Item_Localizador()

;*******************************************************************************
;* Rotina p/ Selecionar e Ordernar Registros                                   *
;*******************************************************************************
Proc Adiciona_Dados_Tabela(TABELA)
Private CONTADOR,CAMPO,TABELA

;Fun‡Æo para fazer automaticamente o INSERT na tabela que ‚ passado como parƒmetro
;a partir de uma ANSWER, isto ‚, a ANSWER dever  ter todos os campos que a tabela
;ir  compor, assim, ‚ verificado a existˆncia desses campos entre a tabela e a Answer
;e assim ‚ feito o INSERT nesta tabela.
;Vale ressaltar que se a TABELA tem mais campos que a Answer, nÆo vai ocorrer nenhum
;problema, pois tudo ‚ baseado na estrutura da ANSWER.

If Not IsTable(TABELA) Or IsEmpty("Answer") 
   Then Return False
EndIf   

CONTADOR = 0
DynArray TAB_ANSWER[]
{Tools} {Info} {Structure} {Answer}
Scan
   If Upper(SubStr([Field Name],1,3))="OBS"
      Then Loop
   EndIf   
   If Type(NumVal(FieldNo([Field Name],TABELA)))="N"
      Then CONTADOR = CONTADOR + 1
           TAB_ANSWER[CONTADOR] = [Field Name]
   EndIf
EndScan
ClearAll

{Ask} {Answer}
For i  From 1 To DynArraySize(TAB_ANSWER)
  Moveto Field TAB_ANSWER[i] Typein "_"+StrVal(i)  
Endfor
{Ask} TypeIn TABELA Enter TypeIn "Fast Insert"
For i  From 1 To DynArraySize(TAB_ANSWER)
  Moveto Field TAB_ANSWER[i] Typein "_"+StrVal(i)  
Endfor
Do_It!
ClearAll

Return True

EndProc ;Adiciona_Dados_Tabela()

;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho                            *
;*******************************************************************************
Proc Adiciona_Indice(TABELA,CAMPO)
Private TABELA,CAMPO,ARRAY_CAMPO,CONT_ARRAY,i,ACHOU_CAMPO

;A vari vel CAMPO pode receber mais de um campo para ser inserido o ¡ndice, separando-o por virgula e em sequˆncia 

Release Vars ARRAY_CAMPO  
DynArray ARRAY_CAMPO[]

PosI=Search(",",CAMPO)
If PosI>0
   Then CONT_ARRAY = 0
        While PosI>0
          CONT_ARRAY = CONT_ARRAY + 1
          ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Ltrim(Format("W1",StrVal(CONT_ARRAY))+SubStr(CAMPO,1,PosI-1))) 
          CAMPO = SubStr(CAMPO,PosI+1,Len(CAMPO))
          PosI=Search(",",CAMPO)
          If PosI=0
             Then CONT_ARRAY = CONT_ARRAY + 1
                  ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Ltrim(Format("W1",StrVal(CONT_ARRAY))+CAMPO)) 
          EndIf         
        EndWhile
   Else ARRAY_CAMPO[1] = "1"+CAMPO
EndIf   
Release Vars CAMPO,CONT_ARRAY

;---- verifica a existˆncia do campo a ser inserido a chave --------------------
ACHOU_CAMPO = ""
{Tools} {Info} {Structure} Typein TABELA Enter
For i From 1 To DynArraySize(ARRAY_CAMPO)
  Moveto [Field Name] 
  Locate SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i]))
  If Not RetVal
     Then ACHOU_CAMPO=SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i])) 
          QuitLoop
  EndIf      
EndFor
Do_It! 
ClearAll

If ACHOU_CAMPO<>""
   Then Mensagem("Campo "+ACHOU_CAMPO+" n„o localizado no processo informado!")
        Return False
EndIf   

If IsTable("Keyviol") Then Delete "Keyviol" EndIf

{Modify} {Restructure} Typein TABELA Enter
If MenuChoice()="Cancel"
  Then {OK}
EndIf  
For i From 1 To DynArraySize(ARRAY_CAMPO)
  Ins Moveto [Field Name] TypeIn SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i])) Right " "
  If i<>DynArraySize(ARRAY_CAMPO) Then Down EndIf   
EndFor
Do_It! 
ClearAll

If IsTable("Keyviol") 
   Then Mensagem("Este processo gerou KeyViol!")
        Return False
EndIf  
Return True

EndProc ;Adiciona_Indice()

;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho                            *
;*******************************************************************************
Proc Adiciona_Indice_Temp(CAMPO)
Private TABELA,CAMPO

If Not Adiciona_Indice("Answer",CAMPO)
   Then Return ""
EndIf

TABELA=Cria_Temp(PrivDir())
Rename "Answer" TABELA 
   
Return TABELA

EndProc ;Adiciona_Indice_Temp()

;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho - Ordena                   *
;*******************************************************************************
Proc Cria_Tabela(TABELA,CAMPO)
Private TABELA,CAMPO

If SubStr(TABELA,Len(TABELA),Len(TABELA))="\\"
   Then Mensagem("Informe a Tabela!")
        Return ""
EndIf

;---- Verifica se o diret¢rio foi passado no parƒmetro ------------------------- 
PosI = Search("\\",TABELA)
If PosI=0
   Then If TABELA=""
           Then TABELA = Cria_Temp(PrivDir())
        EndIf
EndIf           

CRIAR_TABELA2 = True 
CRIAR_TABELA  = True
{Create} TypeIn TABELA Enter
If Not Adiciona_Campo(TABELA,CAMPO)
   Then Return ""
EndIf   
   
Return TABELA

EndProc ;Cria_Tabela()

;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho - Ordena                   *
;*******************************************************************************
Proc Adiciona_Campo_EmOrdem(TABELA,CAMPO)
Private TABELA,CAMPO

REESTRUTURAR=True
Adiciona_Campo(TABELA,CAMPO)

REESTRUTURAR=False
EndProc ;Adiciona_Campo_EmOrdem()

;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho                            *
;*******************************************************************************
Proc Adiciona_Campo(TABELA,CAMPO)
Private TABELA,CAMPO,ARRAY_CAMPO,CONT_ARRAY,i,ACHOU_CAMPO

;A vari vel CAMPO pode receber mais de um campo, separando-o por virgula e em sequˆncia.
;O Tipo do campo dever  ser informado na vari vel CAMPO, sendo passado entre (), por exemplo "Teste(N).Bruno(A4)"
;Adiciona_Campo_EmOrdem() faz com que a estrutura seja refeita conforme passado como parƒmetro

If Not IsAssigned(REESTRUTURAR)  Then REESTRUTURAR=False  EndIf
If Not IsAssigned(CRIAR_TABELA)  Then CRIAR_TABELA=False  EndIf
If Not IsAssigned(CRIAR_TABELA2) Then CRIAR_TABELA2=False EndIf

Release Vars ARRAY_CAMPO,ARRAY_TIPO  
DynArray ARRAY_CAMPO[]
DynArray ARRAY_TIPO[]

PosI=Search(",",CAMPO)
If PosI>0                              
   Then CONT_ARRAY = 0
        While PosI>0
          AUX = Rtrim(Ltrim(SubStr(CAMPO,1,PosI-1)))
          PosP=Search("(",AUX)
          PosF=Search(")",AUX)
          If PosP=0 Or PosF=0
             Then Mensagem("Tipo de Campo passado incorretamente como parametro!")
                  Return False
          EndIf  
          CONT_ARRAY = CONT_ARRAY + 1
          ARRAY_TIPO[CONT_ARRAY] = Format("W1",StrVal(CONT_ARRAY))+SubStr(AUX,PosP+1,PosF-PosP-1)
          ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Format("W1",StrVal(CONT_ARRAY))+SubStr(AUX,1,PosP-1)) 
          CAMPO = SubStr(CAMPO,PosI+1,Len(CAMPO))
          PosI=Search(",",CAMPO)
          If PosI=0
             Then CAMPO=Rtrim(Ltrim(CAMPO))
                  PosP=Search("(",CAMPO)
                  PosF=Search(")",CAMPO)
             
                  If PosP=0 Or PosF=0
                     Then Mensagem("Tipo de Campo passado incorretamente como parametro!")
                          Return False
                  EndIf  
             
                  CONT_ARRAY = CONT_ARRAY + 1
                  ARRAY_TIPO[CONT_ARRAY] = Format("W1",StrVal(CONT_ARRAY))+SubStr(CAMPO,PosP+1,PosF-PosP-1)
                  ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Format("W1",StrVal(CONT_ARRAY))+SubStr(CAMPO,1,PosP-1)) 
          EndIf         
        EndWhile
   Else PosP=Search("(",CAMPO)
        PosF=Search(")",CAMPO)
        CAMPO=Rtrim(Ltrim(CAMPO))
        
        If PosP=0 Or PosF=0
           Then Mensagem("Tipo de Campo passado incorretamente como parametro!")
                Return False
        EndIf  
        
        ARRAY_TIPO[1] = Format("W1",StrVal(1))+SubStr(CAMPO,PosP+1,PosF-1)
        ARRAY_CAMPO[1] = Rtrim(Format("W1",StrVal(1))+SubStr(CAMPO,1,PosP-1))
EndIf   
Release Vars CAMPO,CONT_ARRAY

If Not CRIAR_TABELA
   Then {Modify} {Restructure} Typein TABELA Enter
        If MenuChoice()="Cancel" Then {OK} EndIf
   Else If Not CRIAR_TABELA2
           Then {Create} TypeIn TABELA Enter
                If MenuChoice()="Cancel" Then {OK} EndIf
        EndIf                          
EndIf          
For i From 1 To DynArraySize(ARRAY_CAMPO)
  If REESTRUTURAR And i=1
     Then Moveto [Field Name]
          While [Field Name]<>""
            Del
          EndWhile
  EndIf
  CAMPO=SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i]))                             
  CAMPO=Upper(SubStr(CAMPO,1,1))+SubStr(CAMPO,2,Len(CAMPO))                     ;Primeira letra maiscula no reestructure
  Moveto [Field Name]
  Locate CAMPO
  If Not RetVal
     Then End
          If [Field Name]<>""
             Then Down
          EndIf    
          TypeIn SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i])) Right TypeIn ARRAY_TIPO[i]
  EndIf  
  Home   
EndFor
Do_It! 
While True
  switch
    case MenuChoice()="Delete"   : {Delete}
    case MenuChoice()="Trimming" : {Trimming}
    otherwise                    : QuitLoop
  endswitch
EndWhile

If CRIAR_TABELA
   Then ;If IsAssigned(TABELA) And IsTable(TABELA) Then Moveto TABELA ClearImage EndIf
   Else ClearAll   
EndIf        
Release Vars CAMPO

Return True

EndProc ;Adiciona_Campo()

;*******************************************************************************
;* Rotina p/ organizar a estrutura da tabela                                  *
;*******************************************************************************
Proc Ordem_Campo_Tabela(TABELA,CAMPO)
Private ii,TABELA,CAMPO,ARRAY_CAMPO,CONT_ARRAY,ACHOU_CAMPO

If Not IsTable(TABELA)
   Then Mensagem("Tabela"+TABELA+" n„o localizada!")
        Return
EndIf

Release Vars ARRAY_CAMPO  
DynArray ARRAY_CAMPO[]

PosI=Search(",",CAMPO)
If PosI>0                              
   Then CONT_ARRAY = 0
        While PosI>0
          CONT_ARRAY = CONT_ARRAY + 1
          ARRAY_CAMPO[CONT_ARRAY] = AlinhM(StrVal(CONT_ARRAY),3)+Rtrim(Ltrim(SubStr(CAMPO,1,PosI-1)))  
          CAMPO = SubStr(CAMPO,PosI+1,Len(CAMPO))
          PosI=Search(",",CAMPO)
          If PosI=0
             Then CONT_ARRAY = CONT_ARRAY + 1
                  ARRAY_CAMPO[CONT_ARRAY] = AlinhM(StrVal(CONT_ARRAY),3)+Rtrim(Ltrim(CAMPO)) 
          EndIf         
        EndWhile
   Else ARRAY_CAMPO[1] = "001"+Rtrim(Ltrim(CAMPO))
EndIf   
Release Vars CAMPO,CONT_ARRAY

{Tools} {Info} {Structure} Typein TABELA Enter
Moveto [Field Name]
For ii From 1 To DynArraySize(ARRAY_CAMPO)
  CAMPO=SubStr(ARRAY_CAMPO[ii],4,Len(ARRAY_CAMPO[ii]))
  Home
  Locate CAMPO
  If Not Retval
     Then 
          Mensagem("N„o foi localizado o campo "+CAMPO+" na tabela "+TABELA+"!")
          ClearImage
          Release Vars CAMPO,ARRAY_CAMPO,ii
          Return
  EndIf
EndFor      
ClearImage

{Modify} {Restructure} Typein TABELA Enter
If MenuChoice()="Cancel" Then {OK} EndIf
For ii From 1 To DynArraySize(ARRAY_CAMPO)
  CAMPO=SubStr(ARRAY_CAMPO[ii],4,Len(ARRAY_CAMPO[ii]))
  Moveto [Field Name]
  Ins
  TypeIn CAMPO End
  Moveto [Field Name]
  Locate CAMPO
  Down
EndFor
Do_It! 
While True
  If MenuChoice()="Delete"
     Then {Delete}
     Else QuitLoop
  EndIf
EndWhile

EndProc ;Ordem_Campo_Tabela()

;*******************************************************************************
;* Fun‡Æo se tipo de pessoa ‚ Fisica                                           *
;*******************************************************************************
Proc MudaEstruturaDaTabelaPara(Tabela,TabBase)
Private TabBase, Tabela, campo, s

campo=""

{Tools} {Info} {Structure} Typein TabBase Enter
scan
 s=""
 s=[Field Name]+"("+[Field Type]+")"
 if not isblank(campo)
    then campo=campo+","
 endif   
 campo=campo+s  
Endscan
ClearImage 

Adiciona_Campo_EmOrdem(Tabela,campo)

EndProc

;*******************************************************************************
;* Fun‡Æo se tipo de pessoa ‚ Fisica                                           *
;*******************************************************************************
Proc EstruturaDaTabelaNoKey(Tabela,TabBase)
Private TabBase, Tabela, campo, s

campo=""

{Tools} {Info} {Structure} Typein TabBase Enter
scan
 s=""
 if search("*",[Field Type])>0
    then s=[Field Name]+"("+substr([Field Type],1,len([Field Type])-1)+")"
    else s=[Field Name]+"("+[Field Type]+")"
 endif   
 if not isblank(campo)
    then campo=campo+","
 endif   
 campo=campo+s  
Endscan
ClearImage 

Adiciona_Campo_EmOrdem(Tabela,campo)

EndProc



;*******************************************************************************
;* Rotina p/ Adicionar Indice na Tabela p/ Trabalho                            *
;*******************************************************************************
Proc Adiciona_Indice_Secundario(TABELA,NOME,CAMPO)
Private TABELA,CAMPO,ARRAY_CAMPO,CONT_ARRAY,i,ACHOU_CAMPO

;A vari vel CAMPO pode receber mais de um campo para ser inserido o ¡ndice, separando-o por virgula e em sequˆncia
;Se o NOME do indice n„o for informado, automaticamente receber  o nome de "Ind_Temp"
;Maximo de 10 campos para criar o indice secund rio, pois h  tratamento para este limite  

If NOME="" Then NOME="Ind_Temp" EndIf
If Not IsTable(TABELA) 
   Then Mensagem("Tabela "+TABELA+" n„o Localizada!")
        Return False
EndIf 

Release Vars ARRAY_CAMPO  
DynArray ARRAY_CAMPO[]

PosI=Search(",",CAMPO)
If PosI>0
   Then CONT_ARRAY = 0
        While PosI>0
          CONT_ARRAY = CONT_ARRAY + 1
          ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Ltrim(Format("W1",StrVal(CONT_ARRAY))+SubStr(CAMPO,1,PosI-1))) 
          CAMPO = SubStr(CAMPO,PosI+1,Len(CAMPO))
          PosI=Search(",",CAMPO)
          If PosI=0
             Then CONT_ARRAY = CONT_ARRAY + 1
                  ARRAY_CAMPO[CONT_ARRAY] = Rtrim(Ltrim(Format("W1",StrVal(CONT_ARRAY))+CAMPO)) 
          EndIf         
        EndWhile
   Else ARRAY_CAMPO[1] = "1"+CAMPO
EndIf   
Release Vars CAMPO,CONT_ARRAY

If DynArraySize(ARRAY_CAMPO)>10
   Then Mensagem("Indice Secund rio excedeu o limite permitido para a tabela "+TABELA+"!")
        Return False
EndIf   

;---- verifica a existˆncia do campo a ser inserido a chave --------------------
ACHOU_CAMPO = ""
{Tools} {Info} {Structure} Typein TABELA Enter
For i From 1 To DynArraySize(ARRAY_CAMPO)
  Moveto [Field Name] 
  Locate SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i]))
  If Not RetVal
     Then ACHOU_CAMPO=SubStr(ARRAY_CAMPO[i],2,Len(ARRAY_CAMPO[i])) 
          QuitLoop
  EndIf      
EndFor
 
ClearImage

If ACHOU_CAMPO<>""
   Then Mensagem("Campo "+ACHOU_CAMPO+" n„o localizado no processo informado!")
        Return False
EndIf   

If IsTable("Keyviol") Then Delete "Keyviol" EndIf

Switch
  Case IsAssigned(ARRAY_CAMPO[10]) :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5])),
                                             SubStr(ARRAY_CAMPO[6],2,Len(ARRAY_CAMPO[6])),
                                             SubStr(ARRAY_CAMPO[7],2,Len(ARRAY_CAMPO[7])),
                                             SubStr(ARRAY_CAMPO[8],2,Len(ARRAY_CAMPO[8])),
                                             SubStr(ARRAY_CAMPO[9],2,Len(ARRAY_CAMPO[9])),
                                             SubStr(ARRAY_CAMPO[10],2,Len(ARRAY_CAMPO[10]))
  Case IsAssigned(ARRAY_CAMPO[9])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5])),
                                             SubStr(ARRAY_CAMPO[6],2,Len(ARRAY_CAMPO[6])),
                                             SubStr(ARRAY_CAMPO[7],2,Len(ARRAY_CAMPO[7])),
                                             SubStr(ARRAY_CAMPO[8],2,Len(ARRAY_CAMPO[8])),
                                             SubStr(ARRAY_CAMPO[9],2,Len(ARRAY_CAMPO[9]))
  Case IsAssigned(ARRAY_CAMPO[8])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5])),
                                             SubStr(ARRAY_CAMPO[6],2,Len(ARRAY_CAMPO[6])),
                                             SubStr(ARRAY_CAMPO[7],2,Len(ARRAY_CAMPO[7])),
                                             SubStr(ARRAY_CAMPO[8],2,Len(ARRAY_CAMPO[8]))
  Case IsAssigned(ARRAY_CAMPO[7])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5])),
                                             SubStr(ARRAY_CAMPO[6],2,Len(ARRAY_CAMPO[6])),
                                             SubStr(ARRAY_CAMPO[7],2,Len(ARRAY_CAMPO[7]))
  Case IsAssigned(ARRAY_CAMPO[6])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5])),
                                             SubStr(ARRAY_CAMPO[6],2,Len(ARRAY_CAMPO[6]))
  Case IsAssigned(ARRAY_CAMPO[5])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4])),
                                             SubStr(ARRAY_CAMPO[5],2,Len(ARRAY_CAMPO[5]))
  Case IsAssigned(ARRAY_CAMPO[4])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3])),
                                             SubStr(ARRAY_CAMPO[4],2,Len(ARRAY_CAMPO[4]))
  Case IsAssigned(ARRAY_CAMPO[3])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2])),
                                             SubStr(ARRAY_CAMPO[3],2,Len(ARRAY_CAMPO[3]))
  Case IsAssigned(ARRAY_CAMPO[2])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1])),
                                             SubStr(ARRAY_CAMPO[2],2,Len(ARRAY_CAMPO[2]))
  Case IsAssigned(ARRAY_CAMPO[1])  :
       Index Maintained TABELA Label NOME On SubStr(ARRAY_CAMPO[1],2,Len(ARRAY_CAMPO[1]))
EndSwitch

Return True

EndProc ;Adiciona_Indice_Secundario()





;*******************************************************************************
;* Fun‡Æo se tipo de pessoa ‚ Fisica                                           *
;*******************************************************************************
Proc IsPessoaFisica(valor)
Private valor

If valor="FISICA"
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se tipo de pessoa ‚ Juridica                                         *
;*******************************************************************************
Proc IsPessoaJuridica(valor)
Private valor

If valor="JURIDICA"
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se regime tributario ‚ Simples Nacional                              *
;*******************************************************************************
Proc IsRegimeSimplesNacional(valor)
Private valor

If valor="SIMPLES NACIONAL"  or
   valor="SIMPLES NAC. ESRB" Or    
   valor="SN"                Or    
   valor="SN ESRB"               
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se regime tributario ‚ Simples Nacional ESRB                         *
;*******************************************************************************
Proc IsRegimeSimplesNacionalESRB(valor)
Private valor

If valor="SIMPLES NAC. ESRB" or  
   valor="SN ESRB"               
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se regime tributario ‚ Debito e Credito                              *
;*******************************************************************************
Proc IsRegimeDebitoCredito(valor)
Private valor

If valor="DEBITO/CREDITO"  or  
   valor="LUCRO PRESUMIDO" or 
   valor="LUCRO REAL"       
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se regime tributario ‚ Lucro Real                                    *
;*******************************************************************************
Proc IsRegimeLucroReal(valor)
Private valor

If valor="LUCRO REAL"       
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se regime tributario ‚ Lucro Presumido                               *
;*******************************************************************************
Proc IsRegimeLucroPresumido(valor)
Private valor

If valor="LUCRO PRESUMIDO"       
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Fun‡Æo se Pessoa ‚ Consumidor Final                                         *
;*******************************************************************************
Proc IsPessoaConsumidorFinal(valor)
Private valor

If valor="S"       
   then return true
   else return false
endif   

EndProc

;*******************************************************************************
;* Rotina para Verificar o Per¡odo Informado para Fechamento Mensal            *
;*******************************************************************************
Proc Verifica_Periodo_FechaMes(DATA)
Private DATA,ui,INI_ANO,INI_MES,FIM_ANO,FIM_MES,ANO, MES,ACHOU_ANOMES

If DATA<>""
   Then DT_ANO = SubStr(DATA,1,4)
        DT_MES = SubStr(DATA,6,2)
        ACHOU_ANOMES = False
        
   Else INI_ANO = SubStr(VSDGDTINICIAL,1,4)
        INI_MES = SubStr(VSDGDTINICIAL,6,2)
        
        FIM_ANO = SubStr(VSDGDTFINAL,1,4)
        FIM_MES = SubStr(VSDGDTFINAL,6,2)
        
        POSICAO_INI = 0
        POSICAO_FIM = 0             
EndIf

For ui From 1 To DynArraySize(Array_ListaMesAno)
  ANO = SubStr(Array_ListaMesAno[ui],1,4)
  MES = SubStr(Array_ListaMesAno[ui],6,2)
  
  If DATA=""
     Then If ANO = INI_ANO And MES = INI_MES
             Then POSICAO_INI = ui
          EndIf
          If ANO = FIM_ANO And MES = FIM_MES
             Then POSICAO_FIM = ui
          EndIf
          If POSICAO_INI > 0 And POSICAO_FIM > 0 Then QuitLoop EndIf
     Else If ANO = DT_ANO And MES = DT_MES
             Then ACHOU_ANOMES = True
          EndIf      
  EndIf 
EndFor 

If DATA=""
   Then If POSICAO_INI > 0 And POSICAO_FIM > 0
           Then Return True
           Else Return False
        EndIf
   Else If ACHOU_ANOMES
           Then Return True
           Else Return False      
        EndIf   
EndIf           

EndProc ;Verifica_Periodo_FechaMes()      

;*******************************************************************************
;* Rotina para Verificar o Per¡odo Informado para Fechamento Mensal            *
;*******************************************************************************
Proc Codigo_Barras2(PARAM,EXIBE_MSG)
Private REG_ITENBAR,REG_AUXITEM,EXIBE_MSG,AUX_MSG,RegIten_com

If Not IsAssigned(PARAM_CODBAR_PESO) Then PARAM_CODBAR_PESO = 0 EndIf 
Ok_CODBAR_PESO=False

AUX_MSG       = ""
CODIGO_BARRA2 = ""

GetRecord "\\Sistemas\\Estoque\\Iten_bar" PARAM To REG_ITENBAR
If RetVal
   Then GetRecord "\\Sistemas\\Estoque\\Itens" REG_ITENBAR["Codigo do Item"] To REG_AUXITEM
        If Not RetVal
           Then AUX_MSG = "Item "+REG_ITENBAR["Codigo do Item"]+" n„o foi localizado no sistema!"
                PARAM = ""
           Else PARAM = REG_AUXITEM["Codigo do Item"]
        EndIf                        
   Else AUX_MSG = "C¢digo de Barras "+PARAM+" n„o foi localizado no sistema!"
        ;---- Implementado em 20/07/2017 #0235# --------------------------------
        If PARAM_CODBAR_PESO > 0 And Substr(PARAM,1,1) = "2" And Len(PARAM)=13 
           Then GetRecord "\\Sistemas\\Estoque\\Itens" AlinhM(SubStr(PARAM,2,PARAM_CODBAR_PESO),10) To REG_AUXITEM
                If RetVal
                   Then GetRecord "\\Sistemas\\Estoque\\Iten_com" REG_AUXITEM["Codigo do Item"] To RegIten_com
                        If RetVal
                           Then If RegIten_com["Fracionado"] = "S" And RegIten_com["Peso Variavel"] = "S"
                                   Then AUX_MSG = ""
                                        PARAM = REG_AUXITEM["Codigo do Item"]
                                        Ok_CODBAR_PESO=true
                                EndIf   
                        EndIf   
                EndIf
        EndIf
        If AUX_MSG<>"" 
           Then PARAM = "" 
        EndIf
EndIf

If EXIBE_MSG="S" And AUX_MSG<>""
   Then Mensagem(AUX_MSG)
EndIf   

Release Vars REG_ITENBAR,REG_AUXITEM
If PARAM = ""
   Then Return False
   Else CODIGO_BARRA2 = PARAM
        Return True 
EndIf   
                
EndProc ;Codigo_Barras2()                

;*******************************************************************************
;* PermissÆo p/ Usu rio                                                        *
;*******************************************************************************
Proc Permissao_Usuario(PARAM)
Private PARAM,Libera_Processo

If Not IsAssigned(SYS_CHAPA_USUARIO)
   Then Return True
EndIf   

If SYS_NIVEL_USUARIO="S" 
   Then Return True 
EndIf   

If DirExists(SubStr(Directory(),1,2)+"\\SISTEMAS\\USUARIOS\\"+SYS_CHAPA_USUARIO+"\\")=0
   Then Return False
EndIf

Libera_Processo = True
Switch
  Case PARAM = "Tabela de Preco" : If Not IsTable(SubStr(Directory(),1,2)+"\\SISTEMAS\\USUARIOS\\"+SYS_CHAPA_USUARIO+"\\M_VEND_T")
                                      Then Return False
                                   EndIf   
                                   Libera_Processo = False
                                   View SubStr(Directory(),1,2)+"\\SISTEMAS\\USUARIOS\\"+SYS_CHAPA_USUARIO+"\\M_VEND_T"
                                   Moveto [Comando]
                                   Locate "TbPreco"
                                   If RetVal
                                      Then If [Liberado]<>""
                                              Then Libera_Processo = True
                                           EndIf
                                  EndIf
                                  ClearImage
EndSwitch

Return Libera_Processo

EndProc ;Permissao_Usuario()

;*******************************************************************************
;* Rotina tira quebralinha em campo memo                                       *
;*******************************************************************************
Proc Tira_QuebraLinha(s)
private s, sn, i, ch
     
sn=""
For i from 1 to Len(s)
  ch=SubStr(s,i,1)
  
  Switch
    Case ch     ="\n": ch=" " ;
  EndSwitch
  sn=sn+ch
EndFor
Return sn
EndProc


;*******************************************************************************
;* Rotina dialog fastmsg                                                       *
;*******************************************************************************
Proc SD_Dialogfastmsg(Disparo,Campo,Evento,Elemento)
private Disparo,Campo,Evento,Elemento,Temp  

Temp=True

If Disparo="OPEN"    
   Then ;AoCriarShowDialog() 

        Window Handle Dialog To Janela_fastmsg
        Window GetAttributes Janela_fastmsg To WinArray_fastmsg
        WinArray_fastmsg["HASSHADOW"]=False ;Sombra
        WinArray_fastmsg["HASFRAME"] =False ;Borda
        Window SetAttributes Janela_fastmsg From WinArray_fastmsg

        Dynarray ImageColorSettings_fastmsg[]
        ImageColorSettings_fastmsg[05]=79  
        Window SetColors Janela_fastmsg From ImageColorSettings_fastmsg

        Release Vars WinArray_fastmsg, ImageColorSettings_fastmsg, Janela_fastmsg

        refreshdialog

        Sound 700 5
        Sleep 1000
        Canceldialog           
EndIf

If Disparo="EVENT" And Evento["Type"]="KEY" Then
   Switch
     Case Evento["KeyCode"] =  13 : Temp = False
   EndSwitch
EndIf

Return Temp
EndProc

;*******************************************************************************
;* Rotina Show   fastmsg                                                       *
;*******************************************************************************
proc Showfastmsg(msg)
private msg, w

ShowDialog "" Proc "SD_Dialogfastmsg"
Trigger "OPEN"
Key "ENTER"
 @ 23,00  Height 04 Width 82

  @ 00,01 ?? format("W80,AC",msg)
  @ 01,01 ?? " "   

  Pushbutton @ 09,22 width 11 "~O~k"      OK     Default Value "Ok" Tag "YES" To BottonValue

EndDialog

endproc

;*******************************************************************************
;* Rotina        fastmsg                                                       *
;*******************************************************************************
proc fastmsg(msg)
private msg

showfastmsg(msg)

release procs SD_Dialogfastmsg, Showfastmsg
endproc

;*******************************************************************************
;* Rotina p/ Gravar Log de Exclusao                                            *
;*******************************************************************************
Proc Grava_LogEx(PARAM)
Private PARAM,GRAVA_LOG_TIPO,GRAVA_LOG_NOME,GRAVA_LOG_MSG,VERIFICA_USUARIO

;GRAVA_LOG_TIPO = ""    ->   TIPO
;GRAVA_LOG_NOME = ""    ->   NOME DO PROCESSO
;GRAVA_LOG_MSG  = ""    ->   MENSAGEM DO LOG         

GRAVA_LOG_TIPO = "#"
;Por PadrÆo temos o tipo como #, caso for alterado, informar no switch espec¡fico da rotina o tipo

Switch
  ;---- CADASTRO ---------------------------------------------------------------
  Case PARAM = "Reestruc" :
       GRAVA_LOG_NOME = "Reestruc"
       ;Particularidades
       if Opcao=1
          then GRAVA_LOG_MSG="Reestrutura‡Æo Completa: "
          else GRAVA_LOG_MSG="Reestrutura‡Æo Fechames: "
       endif
       GRAVA_LOG_MSG = GRAVA_LOG_MSG + " Pasta "+Array_Diretorios[PASTA_INI]+" at‚ "+Array_Diretorios[PASTA_FIM] 
  Case PARAM = "ArqBloq" :
       VERIFICA_USUARIO="9999" If IsAssigned(SYS_CHAPA_USUARIO) Then VERIFICA_USUARIO = SYS_CHAPA_USUARIO EndIf 
       GRAVA_LOG_NOME = "ArqBloq"
       GRAVA_LOG_MSG  = "Arquivo de bloqueio referente ao processo "+ROTINA+" gerado pelo usuario "+VERIFICA_USUARIO
       Release Vars VERIFICA_USUARIO
  Case PARAM = "ExclArqB" :
       GRAVA_LOG_NOME = "ExclArqB"
       GRAVA_LOG_MSG  = "Arquivo de bloqueio referente ao processo "+ROTINA+" encerrado pelo usu rio "+USUARIO
  Case PARAM = "LibArq" :
       GRAVA_LOG_NOME = "LibArq"
       GRAVA_LOG_MSG  = "Arquivo de bloqueio referente ao processo "+ROTINA+" LIBERADO pelo usu rio "+USUARIO
  Case PARAM = "Datam" :
       GRAVA_LOG_NOME = "Datam"
       GRAVA_LOG_MSG  = "Datam Executado em "+StrVal(Today())    
  Case PARAM = "Empresa" : 
       GRAVA_LOG_NOME = "ExclEmpr"
       GRAVA_LOG_MSG  = "Excluiu Empresa: "+[Codigo]+" "+[Razao Social]               
  Case PARAM = "Representante" : 
       GRAVA_LOG_NOME = "ExclRep"
       GRAVA_LOG_MSG  = "Excluiu Represen: "+[Codigo do Representante]+" "+[Razao Social Represent]
  Case PARAM = "Usuario" : 
       GRAVA_LOG_NOME = "ExclUsu"
       GRAVA_LOG_MSG  = "Excluiu Usuario: "+[Chapa]+" "+[Nome]+" NA: "+[Nivel de Acesso]+" Data: "+StrVal([Data_Ultima_Execucao])
  Case PARAM = "Email" :
       GRAVA_LOG_NOME = "ExclEmai"
       GRAVA_LOG_MSG  = "Excluiu Email: "+[Email]+" Pessoa: "+[Codigo]
  Case PARAM = "Fornecedor" : 
       GRAVA_LOG_NOME = "ExclFor"
       GRAVA_LOG_MSG  = "Excluiu Fornecedor: "+[Codigo]+" "+[Razao Social]
  Case PARAM = "Cidade" : 
       GRAVA_LOG_NOME = "ExclCid" 
       GRAVA_LOG_MSG  = "Excluiu Cidade: "+[Cidade]+"/"+[UF]+" "+[Pais]
  Case PARAM = "TransfDT" :
       GRAVA_LOG_NOME = "TransfDt"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_TAB + AUX_DATA + AUX_DTREF 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + ", Drive "+VSDGDRIVE+" -> Exportados: "+AUX_OPCAO
  Case PARAM = "TransfCD" :
       GRAVA_LOG_NOME = "TransfCD"
       GRAVA_LOG_MSG  = AUX_DTREF + ", Drive "+VSDGDRIVE+" -> Exportados: "+AUX_OPCAO 
  Case PARAM = "RestauDt" :
       GRAVA_LOG_NOME = "RestauDt"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DTREF + ", Drive "+VSDGDRIVE+" -> Importados: "+AUX_OPCAO
  Case PARAM = "RestauCD" :
       GRAVA_LOG_NOME = "RestauCD"
       GRAVA_LOG_MSG  = AUX_DTREF + ", Drive "+VSDGDRIVE+" -> Importados: "+AUX_OPCAO
  
  ;---- ICMS_IPI ---------------------------------------------------------------
        
  Case PARAM = "ICMS TransfSd" :                                                              
       GRAVA_LOG_NOME = "TransfSd"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_OPCAO + ", Mes/Ano "+VSDGMESANO
  
  ;---- CAIXA/BANCO ------------------------------------------------------------
  Case PARAM = "Ctacor TransfSD" : 
       GRAVA_LOG_NOME = "TransfSD"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + ", Mes/Ano "+VSDGMESANO
  Case PARAM = "Ctacor TransfCB" : 
       GRAVA_LOG_NOME = "TransfCB"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "Ctacor RestauCB" : 
       GRAVA_LOG_NOME = "RestauCB" 
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "Ctacor ReprCcor" : 
       GRAVA_LOG_NOME = "ReprCcor"
       ;Particularidades
       If CheckTG_OPTRANSF[1]
          Then GRAVA_LOG_MSG="Saldo Reprocessou/Transferiu: "
          Else GRAVA_LOG_MSG="Saldo so Reprocessamento    : "
       EndIf
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "Empresa "+VSDGEMPRESA +", Mes/Ano "+VSDGMESANO         
  Case PARAM = "Ctacor ReprCxBc" : 
       GRAVA_LOG_NOME = "ReprCxBc"       
       ;Particularidades
       If CheckTG_OPTRANSF[1]
          Then GRAVA_LOG_MSG="Caixa/Banco Reprocessou/Transferiu: "
          Else GRAVA_LOG_MSG="Caixa/Banco s¢ Reprocessamento    : "
       EndIf
       GRAVA_LOG_MSG=GRAVA_LOG_MSG+" Empresa "+VSDGEMPRESA+", Mes/Ano "+VSDGMESANO
  Case PARAM = "MovCont" : 
       GRAVA_LOG_NOME = "ExclMovC"
       GRAVA_LOG_MSG  = "Excluiu MovCont NL:"+[Numero do Lancamento]+" Conta: "+[Codigo da Conta]+" Empresa: "+[Codigo da Empresa]                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: "+[Codigo do Documento]+"/"+[Numero do Documento]
  Case PARAM = "Conta" : 
       GRAVA_LOG_NOME = "ExclCont"
       GRAVA_LOG_MSG  = "Excluiu Conta: "+[Codigo da Conta]+" Empresa: "+[Codigo da Empresa]+" Tipo Conta: "+[Tipo da Conta]
  Case PARAM = "Plano de Conta" : 
       GRAVA_LOG_NOME = "ExclPlCo"
       GRAVA_LOG_MSG  = "Excluiu Plano de Conta: "+[Codigo Plano_Conta]+" "+[Descricao Plano_Conta]
  Case PARAM = "Centro de Custo" : 
       GRAVA_LOG_NOME = "ExclCCus"
       GRAVA_LOG_MSG  = "Excluiu Centro de Custo: "+[Codigo CCusto]+" "+[Descricao CCusto]
  Case PARAM = "Cliente" : 
       GRAVA_LOG_NOME = "ExclCli"
       GRAVA_LOG_MSG  = "Excluiu Cliente: "+[Codigo]+" "+[Razao Social]

  Case PARAM = "AFBxAutC" : 
       GRAVA_LOG_NOME = "ExclACF"
       GRAVA_LOG_MSG  = "Excluiu Acerto Financeiro NL: "+Strval([Numero do Lote])+" Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])       
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Data: " + Format("D13",[Data da Baixa])+" Conta: "+[Codigo da Conta]+"  "+[Descricao da Conta]

       
  ;---- CONTAS A RECEBER -------------------------------------------------------
  Case PARAM = "Duplic" : 
       GRAVA_LOG_NOME = "ExclCRec"
       GRAVA_LOG_MSG  = "Excluiu Ctarec NL: "+[Numero do Lancamento]+" Docto: "                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Codigo do Documento]+"/"+[Numero do Documento]
  Case PARAM = "Duplic Baixa" :       
       GRAVA_LOG_NOME = "ExclCRec" 
       GRAVA_LOG_MSG  = "Excluiu Ctarec NL/Bx: "+[Numero do Lancamento]+"/"+[Sequencia da Baixa]+" Docto: "               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Duplic->Codigo do Documento]+"/"+[Duplic->Numero do Documento]
       
  ;---- CONTAS A PAGAR ---------------------------------------------------------
  Case PARAM = "Titulos" : 
       GRAVA_LOG_NOME = "ExclCPag" 
       GRAVA_LOG_MSG  = "Excluiu Ctapag NL: "+[Numero do Lancamento]+" Docto: "
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Codigo do Documento]+"/"+[Numero do Documento]
  Case PARAM = "Titulos Baixa" : 
       GRAVA_LOG_NOME = "ExclCPag"
       GRAVA_LOG_MSG  = "Excluiu Ctapag NL/Bx: "+[Numero do Lancamento]+"/"+[Sequencia da Baixa]+" Docto: "                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Titulos->Codigo do Documento]+"/"+[Titulos->Numero do Documento]
  
  ;---- CHEQUE DE TERCEIROS ----------------------------------------------------
  Case PARAM = "Cheque" : 
       GRAVA_LOG_NOME = "ExclChq"
       GRAVA_LOG_MSG  = "Excluiu Cheqrec NL: "+Strval([Numero do Lancamento])+" Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])       
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: " + [Numero Docto Gerador]+" VrTotal Cheque(s): "+StrVal([Valor Total])
  Case PARAM = "ChequeI" : 
       GRAVA_LOG_NOME = "ExclChqI"
       GRAVA_LOG_MSG  = "Excluiu Cheqrec NL/Bx: "+StrVal([Numero do Lancamento])+"/"+StrVal([Sequencia do Cheque])   
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Banco: "+[Codigo_Banco]+" Ag: "+[Agencia]+" Conta: "+[Numero_Conta]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cheque: "+[Numero_Cheque]+" VrChq: "+StrVal([Valor])
 
  ;---- BORDERO ----------------------------------------------------------------
  Case PARAM = "BordChqC" : 
       GRAVA_LOG_NOME = "ExclBoC"
       GRAVA_LOG_MSG  = "Excluiu Bordero NL: "+Strval([Numero do Lote])+" Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])       
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: " + [Numero Docto Gerador]+" VrTotal Lote: "+StrVal([Total Lote])
  Case PARAM = "BordChqI" : 
       GRAVA_LOG_NOME = "ExclBoI"
       GRAVA_LOG_MSG  = "Excluiu Bordero NL/Sq: "+StrVal([Numero do Lote])+"/"+StrVal([Sequencia do Lote])   
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Banco: "+[Codigo_Banco]+" Ag: "+[Agencia]+" Conta: "+[Numero_Conta]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cheque: "+[Numero_Cheque]+" VrChq: "+StrVal([Valor]) 
            
  ;---- ESTOQUE ----------------------------------------------------------------          
  Case PARAM = "RqItem" : 
       GRAVA_LOG_NOME = "ExclRqI" 
       GRAVA_LOG_MSG  = "Excluiu RqItem NL/Sq: "+[Numero do Lancamento]+"/"+StrVal([Sequencia do Lancamento])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" CU: "+StrVal([Custo Unitario])
  Case PARAM = "RqItemG" : 
       GRAVA_LOG_NOME = "ExclRqIG" 
       GRAVA_LOG_MSG  = "Excluiu RqItemG NL/Sq: "+[Numero do Lancamento]+"/"+StrVal([Sequencia do Lancamento])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd Total: "+StrVal([Quantidade])+" CU: "+StrVal([Custo Unitario])
  Case PARAM = "Item RqMatPri" : 
       GRAVA_LOG_NOME = "ExclRqMa"
       GRAVA_LOG_MSG  = "Excluiu RqMatPri NL/Sq: "+[Numero do Lancamento]+"/"+StrVal([Sequencia do Item])+"/"+StrVal([Sequencia Materia Prima])              
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" CU: "+StrVal([Custo Unitario])
  Case PARAM = "Requisicao" : 
       GRAVA_LOG_NOME = "ExclRqc"
       GRAVA_LOG_MSG  = "Excluiu RqCabeca NL: "+[Numero do Lancamento]+" Emp: "+[Codigo da Empresa] 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Tipo: "+[Tipo de Movimento]+"/"+[Tipo de Operacao]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: "+[Codigo do Documento]+" "+[Numero do Documento]+" "+StrVal([Data de Ocorrencia])
  Case PARAM = "Requisicao Grade" : 
       GRAVA_LOG_NOME = "ExclRqcg"
       GRAVA_LOG_MSG  = "Excluiu RqCabecaG NL: "+[Numero do Lancamento]+" Emp: "+[Codigo da Empresa] 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Tipo: "+[Tipo de Movimento]+"/"+[Tipo de Operacao]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: "+[Codigo do Documento]+" "+[Numero do Documento]+" "+StrVal([Data de Ocorrencia])
  Case PARAM = "Rqtrf" : 
       ;Rqtrf nÆo ‚ excluida por ter [Justificativa] p/ cancelamento
       GRAVA_LOG_NOME = "ExclRqtf"
       GRAVA_LOG_MSG  = "Excluiu Rqtrf NL "+[Numero do Lancamento]+"/"+StrVal([Sequencia do Lancamento])               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Emp: "+[Codigo da Empresa]+" TP: "+[Tipo de Movimento]+" Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Qtd: "+StrVal([Quantidade])+" Emp.Destino: "+[Codigo da EmpresaTrf]
  Case PARAM = "Familia" : 
       GRAVA_LOG_NOME = "ExclFam" 
       GRAVA_LOG_MSG  = "Exclui Familia: "+[Codigo da Familia]+" "+[Descricao da Familia]
  Case PARAM = "Grupo" : 
       GRAVA_LOG_NOME = "ExclGrp"
       GRAVA_LOG_MSG  = "Exclui Grupo: "+[Codigo do Grupo]+" "+[Descricao do Grupo]
  Case PARAM = "Marca" : 
       GRAVA_LOG_NOME = "ExclMar" 
       GRAVA_LOG_MSG  = "Exclui Marca: "+[Codigo da Marca]+" "+[Descricao da Marca]
  Case PARAM = "Simbologia" : 
       GRAVA_LOG_NOME = "ExclSimb"
       GRAVA_LOG_MSG  = "Exclui Simbologia: "+[Codigo da Simbologia]+" "+[Descricao da Simbologia]
  Case PARAM = "Unidade" : 
       GRAVA_LOG_NOME = "ExclUnd"
       GRAVA_LOG_MSG  = "Exclui Unidade: "+[Sigla da Unidade] + " " + [Descricao da Unidade] 
  Case PARAM = "Departamento" : 
       GRAVA_LOG_NOME = "ExclDep"
       GRAVA_LOG_MSG  = "Exclui Departamento: "+[Codigo do Departamento]+" "+[Descricao do Departamento]    
  Case PARAM = "Cores" : 
       GRAVA_LOG_NOME = "ExclCor"
       GRAVA_LOG_MSG  = "Exclui Cor: "+[Codigo da Cor_Tecido] + " " + [Descricao da Cor_Tecido] + " " +[Sigla Cor_Tecido]
  Case PARAM = "NCM" : 
       GRAVA_LOG_NOME = "ExclNcm"
       GRAVA_LOG_MSG  = "Exclui NCM: "+[NCM]+ " " + [Descricao NCM]
  Case PARAM = "CEST" : 
       GRAVA_LOG_NOME = "ExclCest"
       GRAVA_LOG_MSG  = "Exclui CEST: "+[CEST]+" "+[Descricao CEST]
  Case PARAM = "Tipo de Grade" :
       GRAVA_LOG_NOME = "ExclTpgr"
       GRAVA_LOG_MSG  = "Exclui Tipo de Grade: "+[Codigo da Grade]+" "+[Descricao da Grade]       
  Case PARAM = "Itens" :  
       GRAVA_LOG_NOME = "ExclItem"
       GRAVA_LOG_MSG  = "Excluiu Item: "+[Codigo do Item]+" "+[Descricao do Item] 
  Case PARAM = "Requisitante" : 
       GRAVA_LOG_NOME = "ExclReqt"
       GRAVA_LOG_MSG  = "Exclui Requisitante: "+[Codigo do Requisitante]+" "+[Descricao Requisitante]
  Case PARAM = "Nota de Entrada" : 
       GRAVA_LOG_NOME = "ExclNteC"
       GRAVA_LOG_MSG  = "Excluiu NotaEc NL: "+[Numero do Lancamento]+" "+" Emp."+[Codigo da Empresa]     
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Tipo: "+[Tipo]+" Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "Item da Nota de Entrada" : 
       GRAVA_LOG_NOME = "ExclNteI"
       GRAVA_LOG_MSG  = "Excluiu NotaEi NL: "+[Numero do Lancamento]+"/"+StrVal([Sequencia do Lancamento])     
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Estoque Reprocess" :
       GRAVA_LOG_NOME = "ReprEstq"
       ;**Particularidaes       
       if CheckTG_OPTRANSF[1]
          then GRAVA_LOG_MSG="Estoque Reprocessou/Transferiu: "
          else GRAVA_LOG_MSG="Estoque s¢ Reprocessamento    : "
       endif
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Empresa "+VSDGEMPRESA+", Item "+VSDGITEM+", Mes/Ano "+VSDGMESANO
  Case PARAM = "RM_0006 ExcItem" :
       GRAVA_LOG_TIPO = ">"
       GRAVA_LOG_NOME = "ExcItem"
       GRAVA_LOG_MSG  = "Excluiu Itens na Rotina RM_0006 do Estoque"
  Case PARAM = "RM_0006 InaItem" :
       GRAVA_LOG_TIPO = ">"
       GRAVA_LOG_NOME = "InaItem"
       GRAVA_LOG_MSG  = "Inativou Itens na Rotina RM_0006 do Estoque"
  Case PARAM = "RestauNE" :
       GRAVA_LOG_NOME = "RestauNE"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "TransfNE" :
       GRAVA_LOG_NOME = "TransfNE"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE 
  Case PARAM = "Estoque RestauBL" :
       GRAVA_LOG_NOME = "RestauBL"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + ", Drive "+VSDGDRIVE
  Case PARAM = "Estoque TransfBL" :
       GRAVA_LOG_NOME = "TransfBL"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "Inativa_CodBar" :
       GRAVA_LOG_NOME = "CodBar"  
       GRAVA_LOG_MSG  = "Ativou CodBarra: "+VSDGCODBARRA+"  Item: "+VSDGCODIGO
  Case PARAM = "Ativa_CodBar" : 
       GRAVA_LOG_NOME = "CodBar" 
       GRAVA_LOG_MSG  = "Ativou CodBarra: "+VSDGCODBARRA+"  Item: "+VSDGCODIGO
  ;---- VENDAS -----------------------------------------------------------------
  Case PARAM = "PontoC" :
       GRAVA_LOG_NOME = "ExclPntC"
       GRAVA_LOG_MSG  = "Excluiu Pontuacao: NL: "+[Numero do Lancamento]+"  "+[Codigo]+" "+[Nome Fantasia EmitDest]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " -> PONTOS "+StrVal([Pontos Quantidade]) + " e SALDO "+StrVal([Pontos Saldo])
  Case PARAM = "PontoI" :
       GRAVA_LOG_NOME = "ExclPntI"
       GRAVA_LOG_MSG  = "Excluiu Documento na Pontuacao: NL: "+[Numero do Lancamento]+"  "+[PontoC->Codigo]+" "+[PontoC->Nome Fantasia EmitDest]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " -> DOCUMENTO: "+[Serie do Documento]+" "+[Numero do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "  PONTOS "+StrVal([Pontos Quantidade]) + " e SALDO "+StrVal([Pontos Saldo])
  Case PARAM = "AltPonto" :
       GRAVA_LOG_NOME = "AltPonto"
       GRAVA_LOG_MSG  = "Pontuacao Alterada: NL: "+[Numero do Lancamento]+"  "+[Pontoc->Codigo]+" "+[Pontoc->Nome Fantasia EmitDest]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " -> PONTOS ANTERIOR "+StrVal([Pontos Quantidade]) + " e SALDO ANTERIOR "+StrVal([Pontos Saldo]) 
  Case PARAM = "Transportador" : 
       GRAVA_LOG_NOME = "ExclTran"
       GRAVA_LOG_MSG  = "Excluiu Transportador: "+[Codigo da Transportadora]+" "+[Razao Social Transport]
  Case PARAM = "Destinacao" : 
       GRAVA_LOG_NOME = "ExclDest"
       GRAVA_LOG_MSG  =  "Excluiu Destinacao: "+[Codigo da Destinacao]+" "+[Descricao da Destinacao]+" "+[CFO]
  Case PARAM = "Vendas CondPagto" : 
       GRAVA_LOG_NOME = "ExclCPgV"
       GRAVA_LOG_MSG  = "Excluiu CondPagto no Vendas: "+[Condicao de Pagamento]+" "+[Descricao CondPagto]              
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " NP: "+StrVal([Numero de Parcelas])+" CD: "+[Composicao de Dias]
  Case PARAM = "DescNota" :
       GRAVA_LOG_NOME = "DescNota"
       GRAVA_LOG_MSG  = "Descancelou Nota Fiscal: "  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "N§ ["+[NotaC->Numero do Documento]+"] Serie do Documento ["+[NotaC->Serie do Documento ]+"] "
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "Codigo da Empresa ["+[NotaC->Codigo da Empresa]+"] Numero da OF ["+[NotaC->Numero da OF]+"]"
  Case PARAM="Lista_Cabeca" :      
       GRAVA_LOG_NOME = "LPresenC"
       GRAVA_LOG_MSG  = "Exclui lan‡amento da lista de presentes: "  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "LANCTO ["+[LPresenC->Numero do Lancamento]+"]"
  Case PARAM="Lista_Item" :      
       GRAVA_LOG_NOME = "LPresenI"
       GRAVA_LOG_MSG  = "LANCTO ["+[LPresenC->Numero do Lancamento]+"]"
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Excluiu Item: "+[LPresenI->Codigo do Item]+" "+[LPresenI->Descricao do Item]
       
  Case PARAM="NumNF" :      
       GRAVA_LOG_NOME = "ExclNumN"
       GRAVA_LOG_MSG  = "Excluiu NumeroNF: Empresa "+[Codigo da Empresa]+" Doc "+[Codigo do Documento]+" "+[Tipo do Documento]+" "+[Serie do Documento]+" "
       GRAVA_LOG_MSG = GRAVA_LOG_MSG + " ProxNum: "+StrVal([Proximo Numero])
  Case PARAM="NumDP" :      
       GRAVA_LOG_NOME = "ExclNumD"
       GRAVA_LOG_MSG  = "Excluiu NumeroDP: Empresa "+[Codigo da Empresa]+" Doc "+[Codigo do Documento]+" "+[Tipo do Documento]+" "+[Serie do Documento]+" "
       GRAVA_LOG_MSG = GRAVA_LOG_MSG + " ProxNum: "+StrVal([Proximo Numero])
            
  ;**Tabela de Pre‡o      
  Case PARAM = "Tabela de Preco" : 
       GRAVA_LOG_NOME = "ExclTbPr"
       GRAVA_LOG_MSG  = "Excluiu Tabela de Pre‡o: "+[Codigo da Tabela]+" "+[Descricao da Tabela]+" "+[Ativa]
  Case PARAM = "Item da Tabela de Preco" : 
       GRAVA_LOG_NOME = "ExclTbPI"
       GRAVA_LOG_MSG  = "Excluiu Item da Tabela de Pre‡o: "+[Codigo da Tabela]+" Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " PtU: "+StrVal([Preco Unitario])
  
  ;**Bib_Tro
  Case PARAM = "BIB_TRO LibCred" :
       GRAVA_LOG_NOME = "LibCred"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Vr="+LTrim(Format("W10.2,EIC",(CREDITO_DISPONIVEL2*-1)))
  Case PARAM = "BIB_TRO BloqDSPC" :
       GRAVA_LOG_NOME = ""
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " UltConsulta="+Format("D13",[Data_Ultima_Consulta])
          
  ;**Bib_Bal                                     
  Case PARAM = "BIB_BAL LibCred" :
       GRAVA_LOG_NOME = "LibCred"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Vr="+LTrim(Format("W10.2,EIC",(CREDITO_DISPONIVEL2*-1)))                               
  Case PARAM = "BIB_BAL LibAtras" :
       GRAVA_LOG_NOME = "LibAtras"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " ND="+LTrim(Format("W10",DIAS_ATRASO))       
  Case PARAM = "BIB_BAL BloqDSPC" :
       GRAVA_LOG_NOME = "BloqDSPC"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " UltConsulta="+Format("D13",[Data_Ultima_Consulta])
  Case PARAM = "BIB_BAL BloqMes" :
       GRAVA_LOG_NOME = "BloqMes"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " UltCompra="+Format("D13",[Data da Ultima Compra])
            
  ;**Bib_Fat
  Case PARAM = "BIB_FAT LibCred" :
       GRAVA_LOG_NOME = "LibCred"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Vr="+LTrim(Format("W10.2,EIC",(CREDITO_DISPONIVEL2*-1)))
  Case PARAM = "BIB_FAT LibAtras" :
       GRAVA_LOG_NOME = "LibAtras"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]  
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " ND="+LTrim(Format("W10",DIAS_ATRASO))
  Case PARAM = "BIB_FAT BloqDSPC" :
       GRAVA_LOG_NOME = "BloqDSPC"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " UltConsulta="+Format("D13",[Data_Ultima_Consulta])
  Case PARAM = "BIB_FAT Restric" :
       GRAVA_LOG_NOME = "Restric"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+" Cliente "+[FaturaC->Codigo]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Restric="+Format("D13",dtrestric)
       
  ;**Bib_Vend
  Case PARAM = "BIB_VEND DesctTot" :
       GRAVA_LOG_NOME = "DesctTot"
       GRAVA_LOG_MSG  = "Fatura: "+ORDFAT+", Descto > "+LTrim(Format("W6.2,EIC",TX_DESCTO_BLOQUEIO))+"%"                     
  Case PARAM = "BIB_VEND DesctUnt" :
       GRAVA_LOG_NOME = "DesctUnt" 
       GRAVA_LOG_MSG  = "Fatura: "+ORDFAT+", Descto > "+LTrim(Format("W6.2,EIC",Tx_calc))+"%"
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+VSD_I_Codigo_Item+" "+VSD_I_Descricao_Item
  Case PARAM = "BIB_VEND AltPreco" :
       GRAVA_LOG_NOME = "AltPreco"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+"/"+StrVal(SEQIT)+", TabPr/CPg: "
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + VSD_I_Tabela+"/"+[FaturaC->Condicao de Pagamento]
       
  ;**ExclusÆo de Registros no Sistema
  Case PARAM = "LIMPA_OF" :                    
       GRAVA_LOG_NOME = "ExclOF"
       GRAVA_LOG_MSG  = "Excluiu OF's: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_EX" :
       GRAVA_LOG_NOME = "ExclExp"
       GRAVA_LOG_MSG  = "Excluiu Exped.: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_NF" :
       GRAVA_LOG_NOME = "ExclNota"
       GRAVA_LOG_MSG  = "Excluiu Notas: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_PD" :
       GRAVA_LOG_NOME = "ExclPed"
       GRAVA_LOG_MSG  = "Excluiu Pedido: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_OR" :
       GRAVA_LOG_NOME = "ExclOR"
       GRAVA_LOG_MSG  = "Excluiu Or‡am.: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_XX" :
       GRAVA_LOG_NOME = "ExclXX"
       GRAVA_LOG_MSG  = "Excluiu NF/DUP: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)
  Case PARAM = "LIMPA_OC" :                    
       GRAVA_LOG_NOME = "ExclOC"
       GRAVA_LOG_MSG  = "Excluiu OC's: "+StrVal(VSDGDTINI)+" a "+StrVal(VSDGDTFIM)       
         
  ;**Restaura‡äes de Dados
  Case PARAM = "VENDAS RestauPD" :                             
       GRAVA_LOG_NOME = "RestauPD"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_TABELA + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "VENDAS RestauOF" :
       GRAVA_LOG_NOME = "RestauOF"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO  + ", Drive "+VSDGDRIVE
  Case PARAM = "VENDAS RestauNf" :
       GRAVA_LOG_NOME = "RestauNf"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE       
  Case PARAM = "VENDAS RestauOE" :
       GRAVA_LOG_NOME = "RestauOE"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "VENDAS RestOFSP" :
       GRAVA_LOG_NOME = "RestOFSP"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "VENDAS RestauCF" :
       GRAVA_LOG_NOME = "RestauCF"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + ", Drive "+VSDGDRIVE

  ;**Transferˆncias de Dados
  Case PARAM = "TRANSFOF" :
       GRAVA_LOG_NOME = "TransfOF"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "TRANSFNF" :
       GRAVA_LOG_NOME = "TransfNF"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + AUX_OPCAO + ", Drive "+VSDGDRIVE
  Case PARAM = "TRANSFCF" :
       GRAVA_LOG_NOME = "TransfCF"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_DTREF + ", Drive "+VSDGDRIVE
  Case PARAM = "TRANSFPD" :
       GRAVA_LOG_NOME = "TransfPD"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_OPCAO + ", Drive "+VSDGDRIVE       
  Case PARAM = "TRANSFOE" :
       GRAVA_LOG_NOME = "TransfOE"
       GRAVA_LOG_MSG  = "Empresa "+VSDGEMPRESA + AUX_DATA + AUX_OPCAO + ", Drive "+VSDGDRIVE       
                                 
  ;**Pedido
  Case PARAM = "Pedido Libera" : 
       GRAVA_LOG_NOME = "AltPedLi"
       GRAVA_LOG_MSG  = "Pedido: "+PEDIDO+", Liberado precos "
  Case PARAM = "Pedido AltPreco" : 
       GRAVA_LOG_NOME = "AltPreco"
       GRAVA_LOG_MSG = "Pedido: "+PEDIDO+"/"+StrVal(SEQIT)+", TabPr/CPg: "                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + VSD_I_Tabela+"/"+[PedidoC->Condicao de Pagamento]
  Case PARAM = "Pedido DesctTot" : 
       GRAVA_LOG_NOME = "DesctTot"
       GRAVA_LOG_MSG  = "Pedido: "+PEDIDO+", Descto > "+LTrim(Format("W6.2,EIC",TX_DESCTO_BLOQUEIO))+"%"
  Case PARAM = "Pedido DesctUnt" : 
       GRAVA_LOG_NOME = "DesctUnt"
       GRAVA_LOG_MSG  = "Fatura: "+PEDIDO+", Descto > "+LTrim(Format("W6.2,EIC",Tx_calc))+"%"
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+VSD_I_Codigo_Item+" "+VSD_I_Descricao_Item             
  Case PARAM = "Pedido" : 
       GRAVA_LOG_NOME = "ExclPed"
       GRAVA_LOG_MSG  = "Excluiu Pedido Normal: "+[Numero do Pedido]+" Emp: "+[Codigo da Empresa]                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "Item do Pedido" : 
       GRAVA_LOG_NOME = "ExclItPI"
       GRAVA_LOG_MSG  = "Excluiu PedidoI: "+[Numero do Pedido]+"/"+StrVal([Item do Pedido])                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Ref: "+[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cor: "+[Codigo da Cor_Tecido]+" "+[Descricao da Cor_Tecido]
  Case PARAM = "PedidoG" : 
       GRAVA_LOG_NOME = "ExclPedG"
       GRAVA_LOG_MSG  = "Excluiu PedidoG: "+[Numero do Pedido]+" Emp: "+[Codigo da Empresa]                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "Item do PedidoG" : 
       GRAVA_LOG_NOME = "ExclItPG" 
       GRAVA_LOG_MSG  = "Excluiu PedidoG: "+[Numero do Pedido]+"/"+StrVal([Item do Pedido])                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Ref: "+[Referencia]+" Cor: "+[Codigo da Cor_Tecido]+" "+[Descricao da Cor_Tecido]
       
  ;**Faturamento
  Case PARAM = "Fatura AltPreco" :    
       GRAVA_LOG_NOME = "AltPreco"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+"/"+StrVal(SEQIT)+", TabPr/CPg: "                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + VSD_I_Tabela+"/"+[FaturaC->Condicao de Pagamento]
  Case PARAM = "Troca AltPreco" :   
       GRAVA_LOG_NOME = "AltPreco"
       GRAVA_LOG_MSG  = "OF: "+ORDFAT+"/"+StrVal(SEQIT)
  Case PARAM = "Fatura" : 
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Fatura: "+[Numero da OF]+" Emp: "+[Codigo da Empresa]               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "Balcao" : 
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Balcao: "+[Numero da OF]+" Emp: "+[Codigo da Empresa]               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])               
  Case PARAM = "Troca"  : 
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Troca: "+[Numero da OF]+" Emp: "+[Codigo da Empresa]               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "FaturaCF" : 
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu FaturaCF: "+[Numero da OF]+" Emp: "+[Codigo da Empresa]               
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
       
  ;**Expedi‡äes
  Case PARAM = "Expedic" : 
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu Expedicao: "+[Numero da OE]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "Expedic2" : 
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu Expedicao de Etiqueta: "+[Numero da OE]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])  
  Case PARAM = "Expedic3" : 
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu Expedicao de Etiqueta: "+[Numero da OE]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "ExpedOfC" : 
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu Expedicao de OF: "+[Numero da OE]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
       
  ;** Or‡amento/Nota/Duplicata/MDFE
  Case PARAM = "OrcaC" : 
       GRAVA_LOG_NOME = "ExclOrc"
       GRAVA_LOG_MSG  = "Excluiu Orcamento: "+[Numero do Orcamento]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "NotaC" : 
       GRAVA_LOG_NOME = "ExclNotC"
       GRAVA_LOG_MSG  = "Excluiu Notac: "+[Codigo da Empresa]+" "+[Numero do Documento]+" "+[Serie do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social])
  Case PARAM = "DupC" : 
       GRAVA_LOG_NOME = "ExclDupC"
       GRAVA_LOG_MSG  = "Excluiu DupC: "+[Codigo da Empresa]+" "+[Numero do Documento]+" "+[Serie do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Pessoa: "+[Codigo]+" "+Format("W20",[Razao Social Fatura])
  Case PARAM = "MDFE" : 
       GRAVA_LOG_NOME = "ExclMDFE"
       GRAVA_LOG_MSG  = "Excluiu MDFE: "+[Numero da OM]+" Emp: "+[Codigo da Empresa]+" MD: "+[Modelo do Documento]           
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Docto: "+[Serie do Documento]+" "+[Numero do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Man: "+[Docto Manifesto]
       
  ;**Itens do Faturamento           
  Case PARAM = "Item do Fatura"    :
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Item Fatura: "+[Numero da OF]+"/"+StrVal([Item da OF])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Item do FaturaCF"  :
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Item FaturaCF: "+[Numero da OF]+"/"+StrVal([Item da OF])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Item do Balcao"    :
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Item Balcao: "+[Numero da OF]+"/"+StrVal([Item da OF])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Item da Troca"     :
       GRAVA_LOG_NOME = "ExclFatC"
       GRAVA_LOG_MSG  = "Excluiu Item Troca: "+[Numero da OF]+"/"+StrVal([Item da OF])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]+" Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  
  ;**Itens das Expedi‡äes
  Case PARAM = "Item da Expedic"   :
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu ExpedI: "+[Numero da OE]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdP: "+StrVal([Quantidade_Pedido])+" QTDE: "+StrVal([Quantidade_Expedida])
  Case PARAM = "Item da Expedic2"  :
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu ExpedIQ: "+[Numero da OE]+"/"+StrVal([Sequencia])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdP: "+StrVal([Quantidade_Pedido])+" QTDE: "+StrVal([Quantidade_Expedida])
  Case PARAM = "Item da Expedic3"  :
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu ExpedIQ: "+[Numero da OE]+"/"+StrVal([Sequencia])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdP: "+StrVal([Quantidade_Pedido])+" QTDE: "+StrVal([Quantidade_Expedida])
  Case PARAM = "Item da ExpedOF"   :
       GRAVA_LOG_NOME = "ExclExpd"
       GRAVA_LOG_MSG  = "Excluiu ExpedOfI: "+[Numero da OE]+"/"+StrVal([Item da OE])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdOF: "+StrVal([Quantidade_OF])+" QTDE: "+StrVal([Quantidade_Expedida])
  
  ;**Itens do Or‡amento/Nota/Duplicata     
  Case PARAM = "Item do Orcamento" :
       GRAVA_LOG_NOME = "ExclOrc"
       GRAVA_LOG_MSG  = "Excluiu Item Orca: "+[Numero do Orcamento]+"/"+StrVal([Item do Orcamento])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Qtd: "+StrVal([Quantidade])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdF:"+StrVal([Quantidade Faturada])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Item da Nota"      :
       GRAVA_LOG_NOME = "ExclNotC"
       GRAVA_LOG_MSG  = "Excluiu Item Nota: "+[Codigo da Empresa]+" "+[Numero do Documento]+" "+[Serie do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "/"+StrVal([Item do Documento])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Item: "+[Codigo do Item]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Qtd: "+StrVal([Quantidade])+" PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Item da DupI"      :
       GRAVA_LOG_NOME = "ExclDupC"
       GRAVA_LOG_MSG  = "Excluiu Item Dup: "+[Codigo da Empresa]+" "+[Numero do Documento]+" "+[Serie do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "/"+[Ordem do Documento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " VrDup: "+StrVal([Valor Duplicata])+" DtV: "+StrVal([Data Vencimento])

  ;**PlugSales
  Case PARAM = "PS_OP"      :
       GRAVA_LOG_NOME = "ExcPS_OP"
       GRAVA_LOG_MSG  = "Excluiu Opera‡Æo PS_OP: ID: "+StrVal([ID])+"  Nome: "+[Nome]+"  Destinacao: "+[Codigo da Destinacao]+" "
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Descricao da Destinacao]+"  Inativo: "+[Inativo]
  Case PARAM = "PS_PG"      :
       GRAVA_LOG_NOME = "ExcPS_PG"
       GRAVA_LOG_MSG  = "Excluiu Opera‡Æo PS_PG: ID: "+StrVal([ID])+"  TipoPagto: "+[Tipo do Pagamento]+" "+[Descricao Tipo Pagamento]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "  CondPagto: "+[Condicao de Pagamento]+" "+[Descricao CondPagto]+"  Inativo: "+[Inativo]
  Case PARAM = "PS_US"      :
       GRAVA_LOG_NOME = "ExcPS_US"
       GRAVA_LOG_MSG  = "Excluiu Opera‡Æo PS_US: ID: "+StrVal([ID])+"  Nome: "+[Nome]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + "  Vendedor: "+[Codigo do Representante]+" "+[Nome Fantasia Represent]+"  Inativo: "+[Inativo]
       
  ;---- PRODUCAO ---------------------------------------------------------------                         
  Case PARAM = "Formula" : 
       GRAVA_LOG_NOME = "ExclForc"
       GRAVA_LOG_MSG  = "Excluiu Formula: "+[Codigo do Produto]+" "+Format("W4",[Codigo Cor_Tecido])+" "+Format("W2",[Tamanho])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdP: "+StrVal([Quantidade Produzida])+" BA: "+[Baixa_Automatica]+" Ref: "+[Referencia]
  Case PARAM = "Item da Formula" : 
       GRAVA_LOG_NOME = "ExclFori"
       GRAVA_LOG_MSG  = "Excluiu Item da Formula: "+[Codigo do Produto]+" "
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + Format("W4",[Codigo Cor_Tecido])+" "+Format("W2",[Tamanho])+"/"+StrVal([Sequencia])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " CM: "+[Codigo do Material]+" Qtd: "+StrVal([Quantidade])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " PrU: "+Strval([Valor Unitario])
        
  ;---- FACCAO -----------------------------------------------------------------       
  ;** Proesso de Fac‡äes
  Case PARAM = "Cfac" : 
       GRAVA_LOG_NOME = "ExclCf"
       GRAVA_LOG_MSG  = "Excluiu ProgCorte: "+[Numero_Corte]+" Emp: "+[Codigo da Empresa]+" Req: "+[Lancamento RqCabeca_CFACC]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Data: "+StrVal([Data_Programacao])
  Case PARAM = "PCfac" : 
       GRAVA_LOG_NOME = "ExclPc"
       GRAVA_LOG_MSG  = "Excluiu ProdCorte: "+[Numero_Producao_Corte]+" Corte: "+[Numero_Programacao_Corte]              
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG +" Data: "+StrVal([Data_Producao])+" Req: "+[Lancamento RqCabeca_PCFAC]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG +" Tit: "+[Numero Lancamento Titulos] 
  Case PARAM = "Pfac" : 
       GRAVA_LOG_NOME = "ExclPf"
       GRAVA_LOG_MSG  = "Excluiu ProgConf: "+[Numero_Programacao]+" Corte: "+[Numero_Corte]+" Emp: "+[Codigo da Empresa]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Req: "+[Lancamento RqCabeca_PFACC]+" Data: "+StrVal([Data_Programacao])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " " + [Destino_Producao]      
  Case PARAM = "Rfac" : 
       GRAVA_LOG_NOME = "ExclRf"
       GRAVA_LOG_MSG  = "Excluiu ProdConf: "+[Numero_Producao]+" Prog: "+[Numero_Programacao]+" Corte: "+[Numero_Corte] 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Emp: "+[Codigo da Empresa]+" Req: "+[Lancamento RqCabeca_RFACC]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Data: "+StrVal([Data_Producao])+" "+[Destino_Producao]
  
  ;** Itens de Faccao
  Case PARAM = "Cfacri" : 
       GRAVA_LOG_NOME = "ExclCfri"
       GRAVA_LOG_MSG  = "Excluiu Item Cfacri: "+[Numero_Corte]+" Item: "+[Codigo do Item]+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " QtdPz: "+StrVal([Quantidade Produzida])                                      
  Case PARAM = "PCfacri" : 
       GRAVA_LOG_NOME = "ExclPcri"
       GRAVA_LOG_MSG  = "Excluiu Item PCfacrig: "+[Numero_Producao_Corte]+" Item: "+[Codigo do Item]+ " Ref: " +[Referencia]           
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " QtdPz: "+StrVal([Quantidade Produzida])
  Case PARAM = "Pfacri" : 
       GRAVA_LOG_NOME = "ExclPfri"
       GRAVA_LOG_MSG  = "Excluiu Item Pfacri: "+[Numero_Programacao]+" Item: "+[Codigo do Item]+ " Ref: " +[Referencia]                         
       GRAVA_LOG_MSG  =  GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " QtdPz: "+StrVal([Quantidade Produzida])
  Case PARAM = "Rfacri" : 
       GRAVA_LOG_NOME = "ExclRfri"
       GRAVA_LOG_MSG  = "Excluiu Item Rfacri: "+[Numero_Producao]+" Item: "+[Codigo do Item]+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " ProcCorte: "+[Numero_Producao_Corte]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " QtdPz: "+StrVal([Quantidade Produzida])
         
  ;** Itens de Grade da Faccao
  Case PARAM = "Cfacrig" : 
       GRAVA_LOG_NOME = "ExclCfrg"
       GRAVA_LOG_MSG  = "Excluiu Item Cfacrig: "+[Numero_Corte]+"/"+StrVal([Sequencia do Lancamento])+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cor:" + [Codigo da Cor_Tecido]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " PrU: "+StrVal([Preco Unitario])
  Case PARAM = "PCfacrig" : 
       GRAVA_LOG_NOME = "ExclPcrg"
       GRAVA_LOG_MSG  = "Excluiu Item PCfacrig: "+[Numero_Producao_Corte]+"/"+StrVal([Sequencia do Lancamento])+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cor:" + [Codigo da Cor_Tecido] 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPz: "+StrVal([Quantidade Produzida]) + " CU: "+StrVal([Custo Unitario])
  Case PARAM = "Pfacrig" : 
       GRAVA_LOG_NOME = "ExclPfrg"
       GRAVA_LOG_MSG  = "Excluiu Item Pfacrig: "+[Numero_Programacao]+"/"+StrVal([Sequencia do Lancamento])+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cor:" + [Codigo da Cor_Tecido] + "ProdCorte: " + [Numero_Producao_Corte]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPg: "+StrVal([Quantidade Programada]) + " PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Rfacrig" : 
       GRAVA_LOG_NOME = "ExclRfrg"
       GRAVA_LOG_MSG  = "Excluiu Item Rfacrig: "+[Numero_Producao]+"/"+StrVal([Sequencia do Lancamento])+ " Ref: " +[Referencia]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Cor:" + [Codigo da Cor_Tecido] + "ProdCorte: " + [Numero_Producao_Corte]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPz: "+StrVal([Quantidade Produzida]) + " PrU: "+StrVal([Preco Unitario])
  Case PARAM = "Rfacrir" : 
       GRAVA_LOG_NOME = "ExclRfrr"
       GRAVA_LOG_MSG  = "Excluiu Item Rfacrir: "+[Numero_Producao]+"/"+StrVal([Sequencia do Lancamento])+"/"+[Codigo do Item]                
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " Ref: " +[Referencia] + " ProdCorte: " + [Numero_Producao_Corte] 
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " NProg: "+[Numero_Programacao] + " QtdPg: "+StrVal([Quantidade Programada])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " QtdPz: "+StrVal([Quantidade Produzida]) + " CU: "+StrVal([Custo Unitario])
       
  ;**Tabela de Pre‡o de Confec‡Æo
  Case PARAM = "Tabela de Preco Confeccao" : 
       GRAVA_LOG_NOME = "ExclTbpf"
       GRAVA_LOG_MSG  = "Excluiu Tabela de Preco de Faccao: "+[Codigo da Tabela]+" "+[Descricao da Tabela]
  Case PARAM = "Item Tabela de Preco Confeccao" : 
       GRAVA_LOG_NOME = "ExclTbpf"
       GRAVA_LOG_MSG  = "Excluiu Item Tabela de Preco de Faccao: "+[Codigo da Tabela]+"/"
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + [Referencia]+"/"+[Codigo da Cor_Tecido]+"/"+Strval([Sequencia])
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " PrU: "+StrVal([Preco Unitario])
       
  ;---- COMPRAS ----------------------------------------------------------------          
  Case PARAM = "Condicao de Pagamento" : 
       GRAVA_LOG_NOME = "ExclCondP" 
       GRAVA_LOG_MSG  = "Excluiu Condicao de Pgamento: "+[Condicao de Pagamento]+" "+[Descricao CondPagto]
       GRAVA_LOG_MSG  = GRAVA_LOG_MSG + " NP: "+StrVal([Numero de Parcelas])+" CD: "+[Composicao de Dias]

  OtherWise : GRAVA_LOG_MSG=""
      ;Processo Gen‚rico       
       PosI = Search(",",PARAM)                                                 ;� passado o nome e ap¢s a virgula, o texto a ser excluido
       If PosI>0
          Then GRAVA_LOG_NOME = SubStr(PARAM,1,PosI-1)                          ;Exemplo: "ExclXXX"    
               GRAVA_LOG_MSG  = SubStr(PARAM,PosI+1,Len(PARAM))                 ;Exemplo: "Excluiu registros XXX: XXXXX"
       EndIf
EndSwitch

If GRAVA_LOG_MSG<>""
   Then Grava_Logt(GRAVA_LOG_TIPO,GRAVA_LOG_NOME,GRAVA_LOG_MSG)
EndIf   

Release Vars PARAM,GRAVA_LOG_TIPO,GRAVA_LOG_NOME,GRAVA_LOG_MSG

EndProc ;Grava_LogEx()

;************************************
;* Rotina para Gravar Log           *
;************************************
Proc Grava_Logt(tp,tpop,op)
Private s,arqtxt,tp,tpop,op,LOG_MES,LOG_ANO,TXT_MES,TXT_ANO

If Not IsAssigned(SYS_CHAPA_USUARIO)    Then SYS_CHAPA_USUARIO    =""  EndIf
If Not IsAssigned(SYS_NOME_USUARIO)     Then SYS_NOME_USUARIO     =""  EndIf
If Not IsAssigned(SYS_NIVEL_USUARIO)    Then SYS_NIVEL_USUARIO    =""  EndIf
If Not IsAssigned(SYS_NCONEXAO)         Then SYS_NCONEXAO         =""  EndIf
If Not IsAssigned(SYS_ESTACAO)          Then SYS_ESTACAO          =""  EndIf
If Not IsAssigned(SYS_SCRIPT)           Then SYS_SCRIPT           =""  EndIf
If Not IsAssigned(SYS_CHAPA_SUPERVISOR) Then SYS_CHAPA_SUPERVISOR =""  EndIf
If Not IsAssigned(SYS_NOME_SUPERVISOR)  Then SYS_NOME_SUPERVISOR  =""  EndIf
If Not IsAssigned(SYS_NIVEL_SUPERVISOR) Then SYS_NIVEL_SUPERVISOR =""  EndIf

;**** LOGSYS.TXT ***************************************************************
LOG_MES = Month(Today())
LOG_ANO = Year(Today())
TXT_MES = Ltrim(StrVal(LOG_MES))                                   If Len(TXT_MES)=1 Then TXT_MES = AlinhM(TXT_MES,2) EndIf 
TXT_ANO = SubStr(StrVal(LOG_ANO),3,2) 
arqtxt  = SubStr(Directory(),1,2)+"\\Sistemas\\Cadastro\\rois"+TXT_MES+TXT_ANO+".log"

s=Format("D13",Today())+" "
s=s+Time()+" "
s=s+Completa(SYS_CHAPA_USUARIO            ,05," ")
s=s+Completa(SubStr(SYS_NOME_USUARIO,1,10),11," ")
s=s+Completa(SYS_NIVEL_USUARIO            ,02," ")
s=s+Completa(Format("W2,AL",SYS_NCONEXAO) ,03," ")        
s=s+Completa(SubStr(SYS_ESTACAO,1,12)     ,13," ")
s=s+tp
s=s+"["+Completa(SYS_SCRIPT      ,8," ")+"]"
s=s+"["+Completa(SubStr(tpop,1,8),8," ")+"]"
If tp="#"
   Then s=s+Completa(SYS_CHAPA_SUPERVISOR            ,05," ")
        s=s+Completa(SubStr(SYS_NOME_SUPERVISOR,1,10),11," ")
        s=s+Completa(SYS_NIVEL_SUPERVISOR            ,01," ")+">"
EndIf
s=s+op
FileWrite Append arqtxt From s+"\n"  
Release Vars s, arqtxt, tp, tpop, op,LOG_MES,LOG_ANO,TXT_MES,TXT_ANO

EndProc   ; (Grava_Logt)

;*******************************************************************************
;* Rotina Bloqueia Tabelas da Pasta                                            *
;*******************************************************************************
Proc BloqueiaTabelas(Pasta)
Private MSG, Pasta, i

For i From 1 to DynArraySize(Array_Tabelas)
  If IsTable(Pasta+Array_Tabelas[i])
     Then Lock Pasta+Array_Tabelas[i] FL
          If Not RetVal
             Then MSG="O usu rio "+Upper(ErrorUser())+" esta usando o Sistema !// //"
                  MSG=MSG+Completa("- Contact -lo para liberar o Sistema;",40," ")+"//"
                  MSG=MSG+Completa("- Esta rotina ser  abortado.",40," ")+"// //"
                  MSG=MSG+"Execute esta rotina novamente para que//"
                  MSG=MSG+"a mesma seja concluida corretamente !"
                  Mensagem(MSG)
                  Return False
          EndIf
  EndIf
EndFor

Return True
EndProc

;*******************************************************************************
;* Rotina Desbloqueia Tabelas da Pasta                                         *
;*******************************************************************************
Proc DesbloqueiaTabelas(Pasta)
Private Pasta, i

For i From 1 to DynArraySize(Array_Tabelas)
  If IsTable(Pasta+Array_Tabelas[i])
     Then UnLock Pasta+Array_Tabelas[i] FL
  EndIf
EndFor

EndProc

;*******************************************************************************
;** Rotina para gerar arquivo de bloqueio de tentativa de acesso ao sistema    *
;*******************************************************************************
Proc Arquivo_Conexao(PARAM,ROTINA)
Private PARAM,ROTINA,ARQUIVO,DIA,VERIFICA_USUARIO

VERIFICA_USUARIO="9999"
If IsAssigned(SYS_CHAPA_USUARIO) 
   Then VERIFICA_USUARIO = SYS_CHAPA_USUARIO
EndIf 

COR_MENSAGEM="1"

ARQUIVO = "\\Sistemas\\Cadastro\\ARQ_BLOQ.INI"
Switch
  Case PARAM = "Bloqueia" :   
       Deleta_Arquivo(ARQUIVO)
                            
       DIA = StrVal(Today())              

       LINHA = ""
       LINHA = LINHA + GravaExpressao("[BLOQUEIO TEMPORARIO]","T","")
       LINHA = LINHA + GravaExpressao("ROTINA","S",ROTINA)        
       LINHA = LINHA + GravaExpressao("USUARIO","S",VERIFICA_USUARIO)
       LINHA = LINHA + GravaExpressao("DIA","S",DIA)              
       FileWrite Append ARQUIVO From LINHA

       Grava_LogEx("ArqBloq")
  Case PARAM = "Desbloqueia" :
       If IsFile(ARQUIVO)
          Then LeiaINI(ARQUIVO,"ROTINA.S.null")
               LeiaINI(ARQUIVO,"USUARIO.S.null")
               Deleta_Arquivo(ARQUIVO)
               Grava_LogEx("ExclArqB")
       EndIf
                
  Case PARAM = "Verifica_Bloqueio" :                              
       If IsFile(ARQUIVO)
          Then LeiaINI(ARQUIVO,"ROTINA.S.null")
               LeiaINI(ARQUIVO,"USUARIO.S.null")
               LeiaINI(ARQUIVO,"DIA.S.null")               

               MSG = Completa("Foi identificado um bloqueio no sistema.",67," ")+"//"
               Switch
                 Case ROTINA = "Reestruturacao" : MSG = MSG + Completa("O usu rio "+USUARIO+" est  executando a reestrutura‡Æo.",67," ")+"////"  
                 Case ROTINA = "MenuPri"        : MSG = MSG + Completa("O usu rio "+USUARIO+" est  executando um processo de atualiza‡Æo do sistema.",67," ")+"////"
                 Case ROTINA = "Reproces"       : MSG = MSG + Completa("O usu rio "+USUARIO+" est  executando o reprocessamento.",67," ")+"////"
                 Case ROTINA = "Balanco"        : MSG = MSG + Completa("O usu rio "+USUARIO+" est  executando a rotina do balan‡o.",67," ")+"////" 
               EndSwitch  
               MSG = MSG + Completa("Este processo nÆo foi concluido ou ainda esta em execu‡Æo.",67," ")+"//"
               MSG = MSG + Completa("Ser  necess rio portanto verificar se este processo foi finalizado,",67," ")+"//"
               MSG = MSG + Completa("ou informar ao usu rio que este processo nÆo foi conclu¡do.",67," ")+"////"
               MSG = MSG + Completa("Verificar com o supervisor para libera‡Æo do sistema.",67," ")
               Mensagem(MSG)
               If Checa_Supervisor()
                  Then COR_MENSAGEM="1"
                       MSG =       Completa("Para prosseguir com o desbloqueio do sistema, esteja ciente de que",67," ")+"//"
                       MSG = MSG + Completa("nÆo h  nenhum processo em execu‡Æo.",67," ")+"////"
                       MSG = MSG + Completa("Um LOG ser  gerado ap¢s o desbloqueio!",67," ")+"//"
                       MSG = MSG + Completa("Deseja continuar com o desbloqueio do sistema?",67," ")
                       If ConfGeral(MSG)
                          Then Deleta_Arquivo(ARQUIVO)
                               Grava_LogEx("LibArq")
                          Else Return False     
                       EndIf   
                  Else Return False
               EndIf   
       EndIf
       Return True
EndSwitch 
          
EndProc ;Arquivo_Conexao()      

;******************************************************************************
;** Monta Procedures                                                        ***
;******************************************************************************
WriteLib "\\Sistemas\\Cadastro\\Bibliot"
  EditField, IsLockRecord, IsLockRecordL, Pagina, Pesquisa, PesquisaCon,
  Confirma, Confirma_Supervisor, ConfGeral_Supervisor, ConfGeral, 
  ConfGeral_N, Mensagem, Monta_Mensagem, SD_ConfGeral, Aguarde, LimpAguarde, 
  ConsultaF1, Consulta_Sem_F1,Cor_Splash,
  Alinh, AlinhM, Completa, AlVar, ChecaCGC, ChecaCPF, Checa_CGC_CPF_Formatado,
  Tipo_CGC_CPF, Centena, Dezena, Unidade, EscExt, MesExt, DiaExt, DatExt,
  EncriptaSenha, Limpa, ErroValid, Dispositivo, DispositivoG, DispositivoI,DispositivoEtq,
  Checa_Dispositivo, SD_Dispositivo, Monta_Prompt_Disp, ImpriRel, MontaGrafico,
  NDecimal, Barra, Supervisor_Dialog, Checa_Supervisor, Cria_Temp, Ultimo_Dia,
  Primeiro_Dia,SYS_Valor,SYS_DATA,
  
  Seleciona_Campo, wait_Memo, wait_Consulta,Wait_Consulta_sem_F1,
  wait_pagina, prompt_Speedbar,
  querexcluir, querdesfazer,
  Tem_Tabelas, Deleta_Arquivo, Deleta_Pasta, Deleta_Arvore,
  Cria_Pasta, Renomeia_Arquivo, Copia_arquivo, XCopia_Arquivo,
  ExecVise,Executa_Programa, Valida_IE, Lista_Diretorio, Lista_DiretorioF,Lista_DiretorioD,
  PegaPosForm, SetaPosForm, SetaCorRegistro, 
  MsgHelp, IsFieldNull,
 
  Edita_Memo,Ver_Memo,Ler_Memo, Ler_CDBarras, SD_DialogLerCodBarra,ProximaOrdem,
  
  AStrVal,  
  SemFuncoes, SemFicha,Abrir_Arquivo,Excluir_Arquivo,
  AguardaTeclasDig, AguardaTeclasDig2,
  AguardaTeclasPadrao  ,  MsgTeclasPadrao  ,  BarraPadrao  ,
  AguardaTeclasPadraoIt,  MsgTeclasPadraoIt,  BarraPadraoIt,
  AguardaTeclasPadraoIt2, MsgTeclasPadraoIt2, BarraPadraoIt2, 
  AguardaTeclasPadraoIt3,
  AguardaTeclasPadraoCF, BarraPadraoCF,
  IsTeclaAtalho,
  Aguardes, LimpAguardes,
  PegaCodigoRaiz, PegaCodigoRaizCor,PegaCodigoRaizAteCor, MudaCodigoPara, 
  TiraTamanhoDescricaoItem, TiraCorTamanhoDescricaoItem, PegaCampoTamanho,
  PrimeiroDia_MesAnterior, UltimoDia_MesPosterior,

  ExecVisecf, ExecViseCons, LerConteudodoArquivo, ExisteArquivo,Adiciona_Dados_Tabela,
  Mensagem2,ConfGeral_N2,ConfGeral2,SD_Mensagem,Mensagem_Padrao,Monta_Mensagem_Lista,
  Verifica_Emissao_Saida,Identifica_MesAno_Periodo,Alinha_Texto, LerConteudodoArquivo8,
  ExisteArquivo8, ExecViseBMT, ExecViseZBR, Cria_FuncaoTemp, 

  OrdenaCampo, CriaTabelaControle, DeletaTabelaControle, CoEditaTabelaControle,
  PegaRegistroControle,AtualizaRegistroControle,GravaExpressao,LeiaINI, AbrirTabela,
  ExibeRodape, LimpaRodape, ExibeRodapeSD,
  SetaCor_Sistema, VerificaRegistroTemp, MenuFiltrar,
  ExibeRodapeSD_Mensagem, MontaRodapeSD, ModoLocalizarItem,Item_Localizador,
  Adiciona_Indice,Adiciona_Indice_Temp,Adiciona_Campo,Adiciona_Campo_EmOrdem,
  Cria_Tabela,Adiciona_Indice_Secundario,IsUsuarioEmpresa,
  Verifica_Periodo_FechaMes, Seta_Ordem_Report,Codigo_Barras2,
  Permissao_Usuario,Tira_QuebraLinha,Monta_Mensagem_Memo,
  Monta_Mensagem_LerMemo,Ordem_Campo_Tabela,
  FastMsg,SD_Dialogfastmsg,Showfastmsg,BloqueiaTabelas,DesbloqueiaTabelas,
  Seta_Altura_Report,MudaEstruturaDaTabelaPara,Grava_LogEx,Grava_Logt,Gravar_logerror,
  EstruturaDaTabelaNoKey,Arquivo_Conexao