VETORES ou MATRIZES

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

Avatar do usuário
Maligno
Membro Master
Membro Master
Mensagens: 6398
Registrado em: 06 Jul 2004 01:40
Localização: Londrina/PR

Mensagem por Maligno »

Passei abaixo um exemplo da minha matriz:

AR:={{},{},{},{}}
AADD(AR[1],"NOME A")
AADD(AR[2],0)
AADD(AR[3],CTOD("01/02/2007"))
AADD(AR[4]," ")
Veja que é absolutamente impossível ordenar essa matriz multidimensional com uma linha de código usando o ASort. Digo isso porque entendo que você está montando uma estrutura que se assemelha a um registro, mas com os campos separados, ao invés de juntos, como seria normal numa estrutura de registro.
Logo, você terá de ordenar um campo e depois, por algum meio (inserindo um campo extra para controle), "sincronizar" os demais campos, em relação ao que foi ordenado.

Mas, se você puder mudar para algo do tipo:

AR:={}
AADD(AR,{"NOME A",0,CTOD("01/02/2007")," "})


aí sim, com a estrutura do registro contiguamente armazenada, será possível ordenar crescentemente pelo código:

ASort(AR,,,{|x,y|x[3]<y[3]})
Em outro tipo de MATRIZ, ora gerada pelo VDIR:=DIRECTORY(), no qual não é uma MATRIZ aninhada como a minha
Observe com atenção. A estrutura da matriz gerada por Directory() é igualzinha a sua. Veja o NG. Portanto, multidimensional também. :)
A diferença é que Directory() retorna uma matriz onde cada elemento é uma matriz que agrega os dados dos arquivos/diretórios na forma tradicional de um registro, com seus campos contíguos, da forma como sugeri que você deveria fazer.
então o ASORT para o VDIR eu fazia:
VDIR:=ASORT(VDIR,,,{ |x,y| DTOS(x) < DTOS(y) })
Mas se eu tentar do mesmo modo para a minha matriz AR, dá error BASE/1120 Argument error: DTOS, porque não está pegando os elementos da terceira coluna_vetor.
Primeiro: esse ordenamento de matriz, sendo a matriz produzida por Directory(), tem que dar erro, já que x e y são matrizes. O correto seria:
ASort(Directory(),,,{|x,y|x[3] < x[3]}). Não é necessário usar DtoS() para converter.

Segundo: o compilador está certo. Tem que reclamar e mostrar erro mesmo. O elemento três da matriz, logo na primeira passada, é uma string. Logo, DtoS() de uma string é erro na certa. :)

Mas, mantendo a estrutura que você montou, o código seria:

ASort(AR[3]), pura e simplesmente (sem o DtoS()). Porque os campos são separados por matrizes distintas. Todas as datas estão no terceiro elemento da matriz. Logicamente, esta matriz é que será ordenada. Mas, se for ordenada, ficará fora de sincronismo com os demais elementos, que perfazem a estrutura do registro de cada indivíduo. Daí a minha idéia de mudar a estrutura do registro, tornando-os contíguos. Facilitaria bastante.

[]'s
Maligno
http://www.buzinello.com/prg
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Maligno escreveu:ASort(AR[3]), pura e simplesmente (sem o DtoS()). Porque os campos são separados por matrizes distintas. Todas as datas estão no terceiro elemento da matriz. Logicamente, esta matriz é que será ordenada. Mas, se for ordenada, ficará fora de sincronismo com os demais elementos, que perfazem a estrutura do registro de cada indivíduo.
Isso aí !. Eu ja estava por acrescentar que o AR:=ASORT(AR[3]) irá fazer direitinho, só que irá ficar um vetor UNIDERECIONAL e os outros elementos irão serem perdidos.
Maligno escreveu:Daí a minha idéia de mudar a estrutura do registro, tornando-os contíguos. Facilitaria bastante.
Pois é, se eu mudar a disposição dos elementos, eu terei que refazer todo o meu conceito do TBROWSE com VETORES. Nunca precisei de ordenar um matriz multidimensional com as disposição de elementos (desta mesma forma vamos dizer). Ora porque eu pego os dados de 3 bancos de dados que são enormes, e eu não gostaria de ter mais um indice (esta seria otra saída), mas preferiria dar um jeito na matris ja que é de tamanho pequeno (geramente não passa de 20 ou 30 linhas_vetor).

Sei lá, é uma situação dificil. Mas re-disposicionar os elementos na matriz, preferiria fazer uma espécie de SORT na munheca... hihihi

I need help !
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

Mensagem por Eolo »

Pablo,

Aí está a matriz ordenada pela 3a. coluna (data). Não precisa do DTOS...

O primeiro FOX/NEXT mostra na ordem natural e, o segundo, em ordem de data.

Código: Selecionar todos

CLEAR
set cent on
set date brit
matriz:={} 
AADD(matriz,{"NOME A", 0, CTOD("01/02/2007"), "2a."}) 
AADD(matriz,{"NOME B", 1, CTOD("22/02/2009"), "3a."}) 
AADD(matriz,{"NOME C", 5, CTOD("12/04/2007"), "4a."}) 
AADD(matriz,{"NOME D", 8, CTOD("05/03/2007"), "5a."}) 
*
for contador=1 to len(matriz)
  ?matriz[contador,1]+str(matriz[contador,2])+dtoc(matriz[contador,3])+matriz[contador,4]
next
wait
*
matriz:=ASORT(matriz,,,{ |x,y| x[3] < y[3] })
for contador=1 to len(matriz)
  ?matriz[contador,1]+str(matriz[contador,2])+dtoc(matriz[contador,3])+matriz[contador,4]
next
wait
quit
Eolo
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

Mensagem por Eolo »

Ops, "BUG":

onde se lê
matriz:=ASORT(matriz,,,{ |x,y| x[3] < y[3] })
leia-se
ASORT(matriz,,,{ |x,y| x[3] < y[3] })

O ASORT() salva a matriz com o mesmo nome, reordenada...

Eolo
Avatar do usuário
Maligno
Membro Master
Membro Master
Mensagens: 6398
Registrado em: 06 Jul 2004 01:40
Localização: Londrina/PR

Mensagem por Maligno »

Pablo César escreveu:Pois é, se eu mudar a disposição dos elementos, eu terei que refazer todo o meu conceito do TBROWSE com VETORES.
Se o conceito do seu TBrowse precisa desse tipo de matriz, pode ser que seu conceito esteja errado. Teria faltado planejamento?

Mas, enfim... Se essa estrutura esquisita faz tanta diferença assim, faça uma boa gambiarra. :)

Monte a matriz com a estrutura que poderá ser ordenada corretamente:

Código: Selecionar todos

aList := {{"D",3,CtoD("07/07/2007"),"Y"},
          {"C",4,CtoD("02/02/2007"),"W"},
          {"A",3,CtoD("04/04/2007"),"Z"},
          {"B",7,CtoD("01/01/2007"),"X"}
          }
Ordene crescentemente, como se faria em condições normais:

Código: Selecionar todos

aList := ASort(aList,,,{|x,y|x[3]<y[3]})
Depois é só alterar a estrutura para aquilo que você precisa:

Código: Selecionar todos

aNew := {{},{},{},{}}
AEval(aList,{|a|AAdd(aNew[1],a[1]),;
                AAdd(aNew[2],a[2]),;
                AAdd(aNew[3],a[3]),;
                AAdd(aNew[4],a[4]) })
E pronto! :)

[]'s
Maligno
http://www.buzinello.com/prg
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

Mensagem por Eolo »

Só tava faltando dizer por QUAL "coluna" vc queria a ordenação.
Eolo
Avatar do usuário
Pablo César
Usuário Nível 7
Usuário Nível 7
Mensagens: 5312
Registrado em: 31 Mai 2006 10:22
Localização: Curitiba - Paraná

Mensagem por Pablo César »

Eolo escreveu:Só tava faltando dizer por QUAL "coluna" vc queria a ordenação.
Por data (terceira coluna_vetor).

Entendí Eolo e Maligno. Neste caso, o jeito é transformar para MATRIZ_CONVENCIONAL, fazer o ASORT e depois retornar ao VETOR_NAO_CONVENCIONAL.

Claro, não tem outra !. Parece ser impossível mesmo. Claro que vou re-avaliar o meu TBROWSE de vetores. Ãgora que estou pensando (não com o coração...) acho que não será muito dificil adaptar a esse tipo de MATRIZ_CONVENCIONAL.

Agora estou entendendo, o por quê sempre eu tive dificuldades em afirmar quando é coluna e quando é linha. A posição linhar, é o que sempre deve variar quando se refere-se a REGISTROS e da forma que eu estava fazendo, é realmente sempre de forma "ANINHADA", acho que é isso o conceito que define essa forma de criar vetores.

É... acho que não vou apelar para esse tipo de conversão, senão... vai ficar dificil entender daqui a uns anos ou meses até...

Valeu, Eolo e Maligno, que bom que eu pude contar com vocês nesta hora. Tenho muito caminho pela frente. Mais tarde irei exemplificar e refazer o TBROWSE para que não dê mau exemplo... Mas acho que tudo é válido, pois errado, não podemos dizer que está errado, só que para utilizar uma VERDADEIRA matriz, não é por esse jeito que eu fazia.

Um clip-abraço, valeu ! :)Pos
microvolution
Usuário Nível 5
Usuário Nível 5
Mensagens: 1231
Registrado em: 02 Set 2011 22:17
Contato:

VETORES ou MATRIZES em Clipper

Mensagem por microvolution »

Prezados, tenho um sistema desenvolvido em Clipper com ajuda do Sculptor da empresa Squadr.com.br.
Acontece que a úlitma versão desenvolvida do sculptor foi em 2000.
De lá pra cá meu aplicativo não tenho alterado nada. Agora em 2011, estava numa oficina mecânica e o mecânico insistiu que eu fizesse uma versão do aplicativo q atendesse a sua necessidade.
Então, acrescentei algumas variáveis e uma delas foi uma para a margem de lucro individual no cadastro de cada produto mVP_MARLUC (o arquivo é o DCI10010.DBF) o PRG desse módulo é o PCI10008.PRG. No aplicativo também tem 3 arquivos q o Sculptor gera onde ficam as rotinas básicas (GCI10000.CH, RCI10000.PRG e ROTINAS5.PRG).
Bom, agora toda vez compilo o programa e faço uma consulta no código do produto pra ver se o produto está cadastrado (a tecla q chama o BROWSE é a F4).
Então dá sempre um dos 2 erros de MATRIZ/VETOR:
* Error base/1068 argumento error: array access; ou
* Error base/1132 argument error: array access.

Gostaria q alguém me ajudasse, se pudereem.
Abaixo seguem as cópias dos arquivos citados àcima:
lembrando q o arquivo q chama o ROTINAS5.PRG é o PCI10008.PRG.
a função q está com o erro base/1068 ou 1132 é a "function CRIABROWSE..." dentro do ROTINAS5.PRG q é chamada de dentro do PCI10008.PRG
Dentro do ROTINAS5.PRG mudei a cor e negritei exatamente onde está acontecendo o erro.
=================
os arquivos estão em anexo:
já os aruivos ROTINAS5 e RCI10000 (PRGs) são mto grandes e ñ cabem aqui... vou apenas colocar a função CRIABROWSE onde acontece o erro em ROTINAS5.PRG, logo abaixo:
==============
parte do ROTINAS5.PRG
-----------

Código: Selecionar todos

* ---------------------------- TRATAMENTO DE BROWSE ---------------------------- *

/************************
* Executa browse em um arquivo refente a um campo de um formulario.
*
*************************/

*function CRIABROWSE (VARIAVEL,NOME_ARQUIVO,CABEC_CAMPOS)
*     local I           := 0,;
 *          TAM         := 0,;
  *         LINHA1      := 2,;
   *        COLUNA1     := 1,;
    *       LINHA2      := 21,;
     *      COLUNA2     := 76,;
      *     N_REGISTROS := 18,;
       *    TECLA       := nil,;
       *    VALOR       := nil,;
       *    SALVA_TELA  := nil,;
*           SALVA_FILT  := dbfilter (),;
*           SALVA_IND   := len (&(alias ()) [1]) - 1,;
*           SALVA_CORR  := indexord (),;
*           ESTRUTURA   := {},;
*           S_TEL       := '',;
*           ARQUIVO     := '',;
*           oTBCOLUMN   := nil
*
 *    private CABEC      := {},;
 *            iCAMPO     := {},;
 *            fCAMPO     := {},;
 *            cCAMPO     := {},;
 *            COLUNA     := {},;
 *            COL_ATIVA  := {},;
 *            POS_REAL   := {},;
 *            ORDEM_ELIM := {},;
 *            VET_LIN    := {},; // Vetor com posicao das linhas.
*             COL_VAL    := {},; // Vetor com colunas de valor.
*             COL_LEG    := 0,;  // Coluna da legenda.
*             FIM_LOOP   := .f.,;
*             FIM_BROW   := .f.,;
*             POS_COL    := 1,;
*             POS_LIN    := 1,;
*             N_CONGEL   := 0,;
*             C_VARIAVEL := 0,;
*             EXP_ORDEN  := '',;
*             CONT       := len (&(alias ()) [1]) - 1,;
*             TITULO     := space (65),;
*             SUB_TITULO := space (65),;
*             TITULO_Y   := space (50)
*
*     CABEC := CABEC_CAMPOS
*     ESTRUTURA := dbstruct ()
*     TAM := 3 * (fcount () - 1) + 3
*     for I := 1 to fcount ()
*          TAM := TAM + max (len (CABEC_CAMPOS [I]),ESTRUTURA [I,3])
*          aadd (COL_ATIVA,1)
*          aadd (POS_REAL,I)
*          if ESTRUTURA[I,1] == substr(VARIAVEL,2)
*               C_VARIAVEL := I
*          endif
*     next I
*     if TAM < (COLUNA2 - COLUNA1 + 1)
*          if TAM < len (NOME_ARQUIVO) + 3
*               TAM := len (NOME_ARQUIVO) + 3
*          endif
*          COLUNA1 := COLUNA2 - TAM
*     endif
*     go top
*     LINHA1 := 2
*     LINHA2 := 21
*     N_REGISTROS := AVANCA_REGISTROS (18)
*     if N_REGISTROS < (LINHA2 - LINHA1 - 2)
*          LINHA1 := LINHA2 - N_REGISTROS - 3
*     endif
*     SALVA_TELA := savescreen (LINHA1 - 1,COLUNA1 - 1,LINHA2 + 1,COLUNA2 + 2)
*     MOLDURA (LINHA1,COLUNA1,LINHA2,COLUNA2,.f.,NOME_ARQUIVO)
*     do while .not. (FIM_LOOP)
*          oTBROWSE := tbrowsedb (LINHA1 + 1,COLUNA1 + 1,LINHA2 - 1,COLUNA2 - 1)
*          oTBROWSE:colorspec += ',' + COR_FUNDO (N_COR (2)) + '+/' + COR_FUNDO (N_COR (1)) +;
*                                ',' + COR_FUNDO (N_COR (2)) + '+/' + COR_FUNDO (N_COR (2))
*          oTBROWSE:headsep := chr (196) + chr (194) + chr (196)
*          oTBROWSE:colsep  := chr (32) + chr (179) + chr (32)
*          FIM_BROW := .f.
*          for I := 1 to fcount ()
*               if COL_ATIVA [I] = 1
*                    if ESTRUTURA [I,2] <> 'M'
*                         oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [I],fieldblock (fieldname (I),select ())))
*                    else
*                         oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [I],{|| '<MEMO>'}))
*                    endif
*                    oTBCOLUMN := oTBROWSE:getcolumn (oTBROWSE:colcount)
*                    if (POS_REAL [oTBROWSE:colcount] = COL_LEG) .or. (ascan (COL_VAL,POS_REAL [oTBROWSE:colcount]) <> 0)
*                         oTBCOLUMN:colorblock := {|x| if (ascan (VET_LIN,recno ()) <> 0,{6,7},{1,2})}
*                    endif
*               endif
*          next I
*          oTBROWSE:gotop ()
*          oTBROWSE:freeze := N_CONGEL
*          oTBROWSE:colpos := POS_COL
*          oTBROWSE:rowpos := POS_LIN
*          do while .not. (FIM_BROW)
*               do while .not. oTBROWSE:stabilize ()  // O Objeto deve ser Estabilizado
*               enddo
*               TECLA   := inkey (0)
*               POS_COL := oTBROWSE:colpos
*               POS_LIN := oTBROWSE:rowpos
*               do case
*               case TECLA = K_ESC
*                    FIM_BROW := .t.
*                    FIM_LOOP := .t.
*               case TECLA = K_ENTER
*                    if ESTRUTURA [POS_REAL [oTBROWSE:colpos],2] <> 'M'
*                         if C_VARIAVEL = 0
*                             C_VARIAVEL = POS_REAL [oTBROWSE:colpos]
*                         endif
*                         VALOR := eval (fieldblock (fieldname (C_VARIAVEL)))
*                         FIM_BROW := .t.
*                         FIM_LOOP := .t.
*                         do case
*                         case valtype (VALOR) = 'D'
*                              VALOR := dtos (VALOR)
*                              if len (dtoc(date())) = 10
*                                   VALOR := substr (VALOR,7) + substr (VALOR,5,2) + substr (VALOR,1,4)
*                              else
*                                   VALOR := substr (VALOR,7) + substr (VALOR,5,2) + substr (VALOR,3,2)
*                              endif
*                              if set (_SET_CONFIRM)
*                                   keyboard VALOR + chr (K_ENTER)
*                              else
*                                   keyboard VALOR
*                              endif
*                         case valtype (VALOR) = 'N'
*                              if set (_SET_CONFIRM)
*                                   keyboard strtran (str (VALOR),' ','0') + chr (K_ENTER)
*                              else
*                                   keyboard strtran (str (VALOR),' ','0')
*                              endif
*                         case valtype (VALOR) = 'C'
*                              for I := 1 to len(ESTRUTURA)
*                                   if (indexord() > 1) .and.;
*                                      (substr(indexkey(indexord()),1,len(ESTRUTURA)) = ESTRUTURA[I,1])
*                                        if ESTRUTURA[I,2] == 'C'
*                                             VALOR := space(01) + VALOR
*                                        endif
*                                   endif
*                              next I
*                              if set (_SET_CONFIRM)
*                                   keyboard VALOR + chr (K_ENTER)
*                              else
*                                   keyboard padr (VALOR,ESTRUTURA [fieldpos (fieldname (C_VARIAVEL)),3])
*                              endif
*                         endcase
*                    else
*                         VALOR := eval (fieldblock (fieldname (POS_REAL [oTBROWSE:colpos])))
*                         S_TEL := savescreen (02,01,23,79)
*                         MOLDURA (02,01,22,77,.f.,'')
*                         VALOR := memoedit (VALOR,03,02,21,76,.f.)
*                         restscreen (02,01,23,79,S_TEL)
*                    endif
*               otherwise
*                    TESTATECLA (oTBROWSE,TECLA)
*               endcase
*          enddo
*     enddo
*     set filter to &(SALVA_FILT)
*     close index
*     for I := SALVA_IND + 1 to CONT
*          ARQUIVO := '$$$$$0' + alltrim (str (I,2,0)) + '.NTX'
*          delete file (ARQUIVO)
*     next I
*     asize (&(alias ()) [1],SALVA_IND + 1)
*     ATIVA_INDICE (SALVA_IND)
*     set order to SALVA_CORR
*     restscreen (LINHA1 - 1,COLUNA1 - 1,LINHA2 + 1,COLUNA2 + 2,SALVA_TELA)
*return nil






function CRIABROWSE (VARIAVEL,NOME_PROGRAMA,NOME_ARQUIVO,CAB_CAMPOS,TAM_CAMPOS,MASC_CAMPOS)

     memvar COD_ACESSO,;
            TEM_SENHA,;
            LIN_MENSAGEM
     
     local I           := 0,;
           N_REGISTROS := 16,;
           TECLA       := nil,;
           VALOR       := nil,;
           SALVA_FILT  := dbfilter (),;
           SALVA_IND   := len (&(alias ()) [1]) - 1,;
           SALVA_ORD   := indexord (),;
           TEL_AUX     := '',;
           ARQ_AUX     := '',;
           oTBCOLUMN   := nil,;
           TENTATIVAS  := 5,;
           COMPARTILHADO   := .t.,;
           EXISTE_ARQ  := .t.,;
           TENTAT,;
           TELA_AUX,;
           NOME_CAMPO,;
           BLOCO

     private iCAMPO      := {},;
             fCAMPO      := {},;
             cCAMPO      := {},;
             COLUNA      := {},;
             ESTRUTURA   := {},;
             CABEC_CAMPOS:= CAB_CAMPOS,; // Cabecalho da colunas do browse
             POS_REAL    := {},; // indica a posicao real do coluna do browse no arquivo de dados
                               ; // mapeamento:  Posicao Coluna --> Posicao Estrutura Fisca
             ORDEM_ELIM  := {{},{}},; // indica a ordem das colunas eliminadas
             FILT_AUX    := dbfilter (),;
             FIM_LOOP    := .f.,;
             FIM_BROW    := .f.,;
             POS_COL     := 1,; // posicao da coluna corrente no browse ativo
             POS_LIN     := 1,; // posicao da linha corrente no browse ativo
             N_CONGEL    := 0,;
             C_VARIAVEL  := 0,; // posicao da varivel a ser retornada
             CONT        := len (&(alias ()) [1]) - 1,;
             AREA_ARQ    := alias(),;
             TAM         := 0,;
             CONTROLE    := .F.,;
             TITULO_BROW := alltrim(substr(NOME_ARQUIVO,1,30)),; // titulo do browse corrente,;
             SALVA_TELA  := nil,;
             LINHA1      := 2,;  // linha superior do browse
             COLUNA1     := 1,;  // coluna mais a esquerada do browse
             LINHA2      := 21,; // linha inferior do browse
             COLUNA2     := 76,; // coluna mais a direita do browse
             oTBROWSE,;
                      ;  // variaveis utilizadas pelo modulo de grafico:
             VET_LIN     := {},; // Vetor com posicao das linhas.
             COL_VAL     := {},; // Vetor com colunas de valor.
             COL_LEG     := 0,;  // Coluna da legenda.
             TITULO     := space (65),;
             SUB_TITULO := space (65),;
             TITULO_Y   := space (50)

     Private ARQ_BROW    := {{{'BROWSE',;
                               'Arquivo de Browse do Sistema',;
                               'BROWSE.DBF'},;
                              {'BROWSE',;
                               'BROWARQ+BROWTITULO',;
                               'BROW001.NTX'},;
                              {'BROWSE',;
                               'BROWARQ+BROWTIPO+STR(BROWCODACE,5)',;
                               'BROW002.NTX'}},;
                             {'BROWARQ',     'C',   8,0},;
                             {'BROWTITULO',  'C',  30,0},;
                             {'BROWFILCOL',  'C',  60,0},;
                             {'BROWFILINI',  'C', 256,0},;
                             {'BROWFILFIN',  'C', 256,0},;
                             {'BROWFILCON',  'C', 256,0},;
                             {'BROWSETORD',  'N',   2,0},;
                             {'BROWCOLATV',  'C', 200,0},;
                             {'BROWCOLELM',  'C', 200,0},;
                             {'BROWCOLCOR',  'N',   2,0},;
                             {'BROWFIXA',    'N',   2,0},;
                             {'BROWTIPO',    'C',   1,0},;
                             {'BROWL1',      'N',   2,0},;
                             {'BROWC1',      'N',   2,0},;
                             {'BROWL2',      'N',   2,0},;
                             {'BROWC2',      'N',   2,0},;
                             {'BROWREGCOR',  'N',   9,0},;
                             {'BROWCODACE',  'N',   5,0}}

*?VARIAVEL,NOME_PROGRAMA,NOME_ARQUIVO,CAB_CAMPOS,TAM_CAMPOS,MASC_CAMPOS // linhas provisórias pra descobrir error base/1132 array access
*INKEY(0)     								// linhas provisórias pra descobrir error base/1132 array access

     ESTRUTURA := dbstruct ()
     POS_REAL := array(fcount())
     TAM := 3 * fcount ()
? "ESTRUTURA",ESTRUTURA, "POS_REAL",POS_REAL,"TAM",TAM
inkey(0)

     //criando arquivo BROWSE.DBF
     if !file(ARQ_BROW[1,1,3])
        EXISTE_ARQ:=.f.
        ARQ_AUX:=aclone(ARQ_BROW)
        ARQ_AUX := adel (ARQ_AUX,1)
        ARQ_AUX := asize (ARQ_AUX,len (ARQ_AUX) - 1)
        dbcreate (ARQ_BROW[1,1,3],ARQ_AUX)
     endif
     
     //criando indices do arquivo BROWSE.DBF
     for I:=2 to len(ARQ_BROW[1])
        if !file(ARQ_BROW[1,I,3]) .or. !EXISTE_ARQ
           use (ARQ_BROW[1,1,3]) alias (ARQ_BROW[1,1,1]) new
           if neterr ()
              TELA_AUX := savescreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79)
              MENSAGEM('Sobrecarga na rede. N„o foi poss¡vel acessar a consulta.')
              inkey(0)
              restscreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79,TELA_AUX)
              return nil
           endif
           index on &(ARQ_BROW[1,I,2]) to (ARQ_BROW[1,I,3])
           close
        endif
     next

     ABRE_ARQUIVO (ARQ_BROW,'TODOS',COMPARTILHADO,TENTATIVAS)

     //>> Restaurando configuracao do browse
     
     select(ARQ_BROW[1,1,1])
     set order to 1
     
     if TEM_SENHA
       set filter to BROWSE->BROWTIPO == "F" .AND. BROWSE->BROWCODACE == COD_ACESSO
     else
         set filter to BROWSE->BROWTIPO == "F"
     endif
     seek(MASC(AREA_ARQ,8)+NOME_PROGRAMA+VARIAVEL)
     if !(alltrim(BROWSE->BROWTITULO) == alltrim(NOME_PROGRAMA+VARIAVEL))
        if INCLUI (TENTATIVAS) .AND. TRAVADO (TENTATIVAS)
           select(AREA_ARQ)
           BROWSE->BROWARQ := AREA_ARQ
           BROWSE->BROWTIPO := "F"
           BROWSE->BROWTITULO := NOME_PROGRAMA+VARIAVEL
           BROWSE->BROWSETORD := indexord()
           BROWSE->BROWCOLCOR := 1
           BROWSE->BROWFIXA   := 0
           BROWSE->BROWREGCOR := 1
           for I := 1 to fcount ()
                TAM := TAM + max (len (CABEC_CAMPOS [I]),ESTRUTURA [I,3])
                BROWSE->BROWCOLATV := alltrim(BROWSE->BROWCOLATV)+;
                                   alltrim(str(I)) +";"
           next I
      
           //>> Faz o calculo de onde sera posicionado o browse
           if TAM < (COLUNA2 - COLUNA1 + 1)
              if TAM < len (TITULO_BROW) + 3
                TAM := len (TITULO_BROW) + 3
             endif
              COLUNA1 := COLUNA2 - TAM
           endif

           go top
           N_REGISTROS := AVANCA_REGISTROS (16)
           if N_REGISTROS < (LINHA2 - LINHA1 - 4)
              LINHA1 := LINHA2 - N_REGISTROS - 5
           endif

           BROWSE->BROWL1     := LINHA1
           BROWSE->BROWC1     := COLUNA1
           BROWSE->BROWL2     := LINHA2
           BROWSE->BROWC2     := COLUNA2

           if TEM_SENHA
              BROWSE->BROWCODACE := COD_ACESSO
           else
              BROWSE->BROWCODACE := 0
           endif

           select(ARQ_BROW[1,1,1])
           unlock
           select(AREA_ARQ)
           go top
        else
           TELA_AUX := savescreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79)
           MENSAGEM('Sobrecarga na rede. N„o foi poss¡vel acessar a consulta.')
           inkey(0)
           restscreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79,TELA_AUX)
           return nil
        endif
     endif
     //<<

     TITULO_BROW := alltrim(substr(NOME_ARQUIVO,1,30))
     
     CARREGA_BROWSE()

     //>>calculando altura da janela do browse
     SELECT(AREA_ARQ) 
     go top
     N_REGISTROS := AVANCA_REGISTROS (16)
     if N_REGISTROS < (LINHA2 - LINHA1 - 4)
        LINHA1 := LINHA2 - N_REGISTROS - 5
     endif
     //<<

     select(ARQ_BROW[1,1,1]) 
     
     COLUNA1 := BROWSE->BROWC1
     COLUNA2 := BROWSE->BROWC2

     select(AREA_ARQ)
     go top
     
     for I := 1 to fcount ()
        if ESTRUTURA[I,1] == substr(VARIAVEL,2)
           C_VARIAVEL := I
        endif
     next

     do while .not. (FIM_LOOP)

          SALVA_TELA := savescreen (LINHA1 - 1,COLUNA1 - 1,LINHA2 + 1,COLUNA2 + 2)
          MOLDURA (LINHA1,COLUNA1,LINHA2,COLUNA2,.f.,TITULO_BROW)

          // Monta o objeto TBrowse
          oTBROWSE := tbrowsedb (LINHA1 + 1,COLUNA1 + 1,LINHA2 - 1,COLUNA2 - 1)
          oTBROWSE:colorspec += ',' + COR_FUNDO (N_COR (2)) + '+/' + COR_FUNDO (N_COR (1)) +;
                                ',' + COR_FUNDO (N_COR (2)) + '+/' + COR_FUNDO (N_COR (2))
          oTBROWSE:headsep := chr (196) + chr (194) + chr (196)
          oTBROWSE:colsep  := chr (32) + chr (179) + chr (32)
          oTBROWSE:footsep := chr (196) + chr (193) + chr (196)
          FIM_BROW := .f.

          // adiciona colunas a browse
          for I := 1 to LEN(POS_REAL)-LEN(ORDEM_ELIM[1])
                 if ESTRUTURA [I,2] <> 'M'
? "I",I,"LEN(POS_REAL)",LEN(POS_REAL),"LEN(ORDEM_ELIM[1])",LEN(ORDEM_ELIM[1])  // linhas provisórias pra descobrir error base/1132 array access
? "ESTRUTURA [I,2]",ESTRUTURA [I,2]                                            // linhas provisórias pra descobrir error base/1132 array access
? "MASC_CAMPOS[POS_REAL[I]]",MASC_CAMPOS[POS_REAL[I]]                          // linhas provisórias pra descobrir error base/1132 array access
INKEY(0)                                                                       // linhas provisórias pra descobrir error base/1132 array access
                     if empty(MASC_CAMPOS[POS_REAL[I]])
                        oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL[I]],fieldblock (fieldname (POS_REAL[I]) )))
                     else
                        NOME_CAMPO := fieldname (POS_REAL[I])
                        BLOCO := "{|XX|transform(if(XX==NIL,"+NOME_CAMPO+","+NOME_CAMPO+":= XX),'"+MASC_CAMPOS[POS_REAL[I]]+"')}"
                        oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL[I]],&(BLOCO) ))
                     endif
                 else
                     oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL[I]],{|| '<MEMO>'}))
                 endif
                 oTBCOLUMN := oTBROWSE:getcolumn (oTBROWSE:colcount)
                 oTBCOLUMN:cargo := array (3)

                 oTBCOLUMN:Cargo[COL_TAMREL] := TAM_CAMPOS[POS_REAL[I]]
                 oTBCOLUMN:Cargo[COL_MASC  ] := MASC_CAMPOS[POS_REAL[I]]

                 oTBCOLUMN:Cargo[COL_EXP   ] := fieldname (POS_REAL[I])

          next I

          for I := 1 to len(ORDEM_ELIM[1])
                if ESTRUTURA [ORDEM_ELIM[1,I],2] <> 'M'
                   if empty(MASC_CAMPOS[ORDEM_ELIM[1,I]])
                        oTBCOLUMN := tbcolumnnew (CABEC_CAMPOS [ORDEM_ELIM[1,I]],fieldblock (fieldname (ORDEM_ELIM[1,I]) ))
                     else
                        NOME_CAMPO := fieldname (ORDEM_ELIM[1,I])
                        BLOCO := "{|XX|transform(if(XX==NIL,"+NOME_CAMPO+","+NOME_CAMPO+":= XX),'"+MASC_CAMPOS[ORDEM_ELIM[1,I]]+"')}"
                        oTBCOLUMN := tbcolumnnew (CABEC_CAMPOS [ORDEM_ELIM[1,I]],&(BLOCO) )
                     endif
                 else
                    oTBCOLUMN := tbcolumnnew (CABEC_CAMPOS [ORDEM_ELIM[1,I]],{|| '<MEMO>'})
                 endif
                 aadd(ORDEM_ELIM[2],oTBCOLUMN)
                 oTBCOLUMN:cargo := array (3)
                 oTBCOLUMN:footsep := chr (196) + chr (193) + chr (196)

                 oTBCOLUMN:Cargo[COL_TAMREL] := TAM_CAMPOS[ORDEM_ELIM[1,I]]
                 oTBCOLUMN:Cargo[COL_MASC  ] := MASC_CAMPOS[ORDEM_ELIM[1,I]]

                 oTBCOLUMN:Cargo[COL_EXP   ] := fieldname (ORDEM_ELIM[1,I])

          next I

          oTBROWSE:freeze := N_CONGEL
          oTBROWSE:colpos := POS_COL
          oTBROWSE:rowpos := POS_LIN

          STATUS_RODAPE()

          //>> Exibicao e ativacao do browse
          do while .not. (FIM_BROW)
               do while .not. oTBROWSE:stabilize ()  // O Objeto deve ser Estabilizado
               enddo
               TECLA   := inkey (0)
               POS_COL := oTBROWSE:colpos
               POS_LIN := oTBROWSE:rowpos
               do case
               case TECLA = K_ESC
                    FIM_BROW := .t.
                    FIM_LOOP := .t.
               case TECLA = K_ENTER
                    if ESTRUTURA [POS_REAL [oTBROWSE:colpos],2] <> 'M'
                         if C_VARIAVEL = 0
                             C_VARIAVEL = POS_REAL [oTBROWSE:colpos]
                         endif
                         VALOR := eval (fieldblock (fieldname (C_VARIAVEL)))
                         FIM_BROW := .t.
                         FIM_LOOP := .t.
                         do case
                         case valtype (VALOR) = 'D'
                              VALOR := dtos (VALOR)
                              if len (dtoc(date())) = 10
                                   VALOR := substr (VALOR,7) + substr (VALOR,5,2) + substr (VALOR,1,4)
                              else
                                   VALOR := substr (VALOR,7) + substr (VALOR,5,2) + substr (VALOR,3,2)
                              endif
                              if set (_SET_CONFIRM)
                                   keyboard VALOR + chr (K_ENTER)
                              else
                                   keyboard VALOR
                              endif
                         case valtype (VALOR) = 'N'
                              if set (_SET_CONFIRM)
                                   keyboard strtran (str (VALOR),' ','0') + chr (K_ENTER)
                              else
                                   keyboard strtran (str (VALOR),' ','0')
                              endif
                         case valtype (VALOR) = 'C'
                              if set (_SET_CONFIRM)

                                   if alias()='DCI10024'                   // Linhas acrescentadas por
                                        mEDTIPO   :=DCI10024->EDTIPO       // Walcledson em 09/07/2001
                                        mEDLOGRADO:=DCI10024->EDLOGRADO    // para que o BROWSE pudes-
                                        mEDBAIRRO :=DCI10024->EDBAIRRO     // atualizar o Endere‡o  do
                                        mNUCEP    :=DCI10024->NUCEP        // Cliente, se a rua/ave de
                                        mEDCIDADE :=DCI10024->EDCIDADE     // sua residˆncia tiver   +
                                        mEDUF     :=DCI10024->EDUF         // de um CEP/BAIRRO/etc.,  
                                   endif                                   // sem essas linhas nÆo funciona corretamente o cadastro de endere‡os.

                                   keyboard VALOR + chr (K_ENTER)
                             else
                                   if alias()='DCI10024'                   // Linhas acrescentadas por
                                        mEDTIPO   :=DCI10024->EDTIPO       // Walcledson em 09/07/2001
                                        mEDLOGRADO:=DCI10024->EDLOGRADO    // para que o BROWSE pudes-
                                        mEDBAIRRO :=DCI10024->EDBAIRRO     // atualizar o Endere‡o  do
                                        mNUCEP    :=DCI10024->NUCEP        // Cliente, se a rua/ave de
                                        mEDCIDADE :=DCI10024->EDCIDADE     // sua residˆncia tiver   +
                                        mEDUF     :=DCI10024->EDUF         // de um CEP/BAIRRO/etc.,  
                                   endif                                   // sem essas linhas nÆo funciona corretamente o cadastro de endere‡os.

                                   keyboard padr (VALOR,ESTRUTURA [fieldpos (fieldname (C_VARIAVEL)),3])
                              endif
                         endcase
                    else
                         VALOR := eval (fieldblock (fieldname (POS_REAL [oTBROWSE:colpos])))
                         TEL_AUX := savescreen (02,01,23,79)
                         MOLDURA (02,01,22,77,.f.,'')
                         VALOR := memoedit (VALOR,03,02,21,76,.f.)
                         restscreen (02,01,23,79,TEL_AUX)
                    endif
               otherwise
                    TESTATECLA (TECLA)
               endcase
          enddo
     enddo
     
     //>>Salvar Browse

     select(ARQ_BROW[1,1,1])
     set order to 1
     if TEM_SENHA
        set filter to BROWSE->BROWTIPO == "F" .AND. BROWSE->BROWCODACE == COD_ACESSO
     else
        set filter to BROWSE->BROWTIPO == "F"
     endif

     if TRAVADO(TENTATIVAS)
        SALVA_BROWSE()
        unlock
     else
        TELA_AUX := savescreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79)
        MENSAGEM('Sobrecarga na rede. N„o foi poss¡vel salvar a consulta.')
        inkey(0)
        restscreen(LIN_MENSAGEM,0,LIN_MENSAGEM,79,TELA_AUX)
     endif

     select(ARQ_BROW[1,1,1])
     CLOSE
     //<<

     select(AREA_ARQ)
     set filter to &(SALVA_FILT)
     close index
     for I := SALVA_IND + 1 to CONT
          ARQ_AUX := '$$$$$0' + alltrim (str (I,2,0)) + '.NTX'
          delete file (ARQ_AUX)
     next I
     asize (&(alias ()) [1],SALVA_IND + 1)
     ATIVA_INDICE (SALVA_IND)
     set order to SALVA_ORD
     restscreen (LINHA1 - 1,COLUNA1 - 1,LINHA2 + 1,COLUNA2 + 2,SALVA_TELA)
     
return nil

/*************************
* Ativa um menu de browses disponiveis, relativo ao usuario ativo 
* (caso haja controle de acesso atraves de senha), para um determinado 
* arquivo da area corrente. 
*
*************************/

function BROWSE_ARQ (CAB_CAMPOS,TAM_CAMPOS,MASC_CAMPOS)

memvar COD_ACESSO,TEM_SENHA

local OPCOES := {},;
      SALVA_FILT  := dbfilter (),;
      SALVA_IND   := len (&(alias ()) [1]) - 1,;
      SALVA_ORD   := indexord (),;
      I,;
      L1:=2,;
      C1:=1,;
      L2:=21,;
      C2:=76,;
      TITULO_MENU,;
      LARG_MENU := 0,;
      OP_ESCOLHIDA:=1,;
      N_REG,;
      TELA_AUX,;
      TELA_SALVA,;
      SALVA_INTENSIDADE:=set(_SET_INTENSITY,.t.),;
      TAM,;
      ARQ_AUX,;
      EXISTE_ARQ:=.t.,;
      COMPARTILHADO:=.t.,;
      TENTATIVAS:=5,;
      AREA_ARQ:=alias(),;
      ESTRUTURA,;
      N_REGISTROS:=16

Private CONT := len (&(alias ()) [1]) - 1


     Private ARQ_BROW    := {{{'BROWSE',;
                               'Arquivo de Browse do Sistema',;
                               'BROWSE.DBF'},;
                              {'BROWSE',;
                               'BROWARQ+BROWTITULO',;
                               'BROWSE.NTX'}},;
                             {'BROWARQ',     'C',   8,0},;
                             {'BROWTITULO',  'C',  30,0},;
                             {'BROWFILCOL',  'C',  60,0},;
                             {'BROWFILINI',  'C', 256,0},;
                             {'BROWFILFIN',  'C', 256,0},;
                             {'BROWFILCON',  'C', 256,0},;
                             {'BROWSETORD',  'N',   2,0},;
                             {'BROWCOLATV',  'C', 200,0},;
                             {'BROWCOLELM',  'C', 200,0},;
                             {'BROWCOLCOR',  'N',   2,0},;
                             {'BROWFIXA',    'N',   2,0},;
                             {'BROWTIPO',    'C',   1,0},;
                             {'BROWL1',      'N',   2,0},;
                             {'BROWC1',      'N',   2,0},;
                             {'BROWL2',      'N',   2,0},;
                             {'BROWC2',      'N',   2,0},;
                             {'BROWREGCOR',  'N',   9,0},;
                             {'BROWCODACE',  'N',   5,0}}

     ESTRUTURA := dbstruct ()
     TAM := 3 * fcount()

     //criando arquivo BROWSE.DBF
     if !file(ARQ_BROW[1,1,3])
        EXISTE_ARQ:=.f.
        ARQ_AUX:=aclone(ARQ_BROW)
        ARQ_AUX := adel (ARQ_AUX,1)
        ARQ_AUX := asize (ARQ_AUX,len (ARQ_AUX) - 1)
        dbcreate (ARQ_BROW[1,1,3],ARQ_AUX)
     endif
     
     //criando indices do arquivo BROWSE.DBF
     for I:=2 to len(ARQ_BROW[1])
        if !file(ARQ_BROW[1,I,3]) .or. !EXISTE_ARQ
           use (ARQ_BROW[1,1,3]) alias (ARQ_BROW[1,1,1]) shared new
           if neterr ()
               CANCELA_EXECUCAO ('Erro de Abertura ' + ARQ_BROW[1,1,3] + ' - Arquivo nao compartilhado')
           endif
           index on &(ARQ_BROW[1,I,2]) to (ARQ_BROW[1,I,3])
           close
        endif
     next

     ABRE_ARQUIVO (ARQ_BROW,'TODOS',COMPARTILHADO,TENTATIVAS)
          
     //>> Restaurando configuracao do ultimo browse de arquivo chamado
     select(ARQ_BROW[1,1,1])
     set order to 1
     if TEM_SENHA
        set filter to BROWSE->BROWTIPO == "A" .and.;
                      (BROWSE->BROWCODACE == COD_ACESSO .or. BROWSE->BROWCODACE == 0)
     else
        set filter to BROWSE->BROWTIPO == "A"
     endif
     seek(AREA_ARQ)
     if !(alltrim(BROWSE->BROWARQ) == alltrim(AREA_ARQ))
        if INCLUI (TENTATIVAS) .AND. TRAVADO (TENTATIVAS)
           select(AREA_ARQ)
           BROWSE->BROWARQ := AREA_ARQ
           BROWSE->BROWTIPO := "A"
           BROWSE->BROWTITULO := alltrim(&(AREA_ARQ)[1,1,2])
           BROWSE->BROWSETORD := indexord()
           BROWSE->BROWCOLCOR := 1
           BROWSE->BROWFIXA   := 0
           BROWSE->BROWREGCOR := 1
           for I := 1 to fcount ()
              TAM := TAM + max (len (CAB_CAMPOS [I]),ESTRUTURA [I,3])
              BROWSE->BROWCOLATV := alltrim(BROWSE->BROWCOLATV)+;
                                    alltrim(str(I)) +";"
           next I

           //>> Faz o calculo de onde sera posicionado o browse
           if TAM < (C2 - C1 + 1)
              if TAM < len (BROWSE->BROWTITULO) + 3
                 TAM := len (BROWSE->BROWTITULO) + 3
              endif
              C1 := C2 - TAM
           endif
          
           L1 := 2
           L2 := 21
           N_REGISTROS := AVANCA_REGISTROS (16)
           if N_REGISTROS < (L2 - L1 - 4)
              L1 := L2 - N_REGISTROS - 5
           endif

           BROWSE->BROWL1     := L1
           BROWSE->BROWC1     := C1
           BROWSE->BROWL2     := L2
           BROWSE->BROWC2     := C2
           go top
        else
           TELA_AUX := savescreen(22,0,22,79)
           MENSAGEM('Sobrecarga na rede. N„o foi poss¡vel acessar a consulta.')
           inkey(0)
           restscreen(22,0,22,79,TELA_AUX)
           return nil
        endif
        //<<
     endif
     while OP_ESCOLHIDA != 0
        select(ARQ_BROW[1,1,1])
        N_REG:=recno()
        go top
        set order to 1
        seek(AREA_ARQ)
        TITULO_MENU := "Consultas Dispon¡veis"
        LARG_MENU := len(TITULO_MENU)
        OPCOES:={}
        while BROWSE->BROWARQ ==  AREA_ARQ .and. !eof() 
           aadd(OPCOES,ALLTRIM(BROWSE->BROWTITULO))
           LARG_MENU := max (LARG_MENU,len (BROWSE->BROWTITULO))
           skip
        enddo
        
        // exibir browses disponiveis
        if len(OPCOES) != 0
           L1 := 5
           C1 := 6
           L2 := L1 + iif(len(OPCOES)<= 19-L1,len(OPCOES),19-L1) - 1
           C2 := C1 + LARG_MENU
           TELA_SALVA := savescreen(L1-1,C1-1,L2+2,C2+3)
           MOLDURA (L1-1,C1-1,L2+1,C2+1,.f.,ALLTRIM(TITULO_MENU))
           OP_ESCOLHIDA := achoice(L1,C1,L2,C2,OPCOES,,OP_ESCOLHIDA)

           go N_REG
           if OP_ESCOLHIDA <> 0
              seek(MASC(AREA_ARQ,8)+MASC(OPCOES[OP_ESCOLHIDA],30))
              select(AREA_ARQ)
              CRIABROWARQ(CAB_CAMPOS,TAM_CAMPOS,MASC_CAMPOS)
           endif
           restscreen(L1-1,C1-1,L2+2,C2+3,TELA_SALVA)
        else
           go N_REG
           TELA_AUX := savescreen(22,0,22,79)
           MENSAGEM('N„o h  consultas dispon¡veis.')
           inkey(0)
           restscreen(22,0,22,79,TELA_AUX)
           OP_ESCOLHIDA:=0
        endif
     enddo
     set(_SET_INTENSITY,SALVA_INTENSIDADE)
     select(ARQ_BROW[1,1,1])
     set filter to
     CLOSE

     select(AREA_ARQ)
     set filter to &(SALVA_FILT)
     close index
     for I := SALVA_IND + 1 to CONT
          ARQ_AUX := '$$$$$0' + alltrim (str (I,2,0)) + '.NTX'
          delete file (ARQ_AUX)
     next I
     asize (&(alias ()) [1],SALVA_IND + 1)
     ATIVA_INDICE (SALVA_IND)
     set order to SALVA_ORD

return nil

========= fim de parte do arquivo ROTINAS5.PRG
Anexos
PCI10008.PRG
(60.81 KiB) Baixado 435 vezes
DCI10010.PRG
(1.56 KiB) Baixado 433 vezes
GCI10000.CH
(15.37 KiB) Baixado 555 vezes
Editado pela última vez por Pablo César em 20 Set 2011 10:22, em um total de 1 vez.
Razão: Mensagem editada para colocar a tag [ code ]<br>Veja como utilizar esta tag: http://www.pctoledo.com.br/forum/faq.php?mode=bbcode#f2r1
Grato,
MICROVOLUTION - 16 anos Evoluindo Com Você!


Você já leu a Bíblia hoje?
João 3:16 - Porque Deus amou ao mundo de tal maneira que deu seu Único Filho para que todo aquele que nEle crê não pereça mas tenha a Vida Eterna!
microvolution
Usuário Nível 5
Usuário Nível 5
Mensagens: 1231
Registrado em: 02 Set 2011 22:17
Contato:

VETORES ou MATRIZES em Clipper

Mensagem por microvolution »

prezados, do arquivo ROTINAS5.PRG q destaquei a função CRIABROWSE..., estou selecionando abaixo, apenas o local exato onde ocorre os erros que mencionei:
========
for I := 1 to LEN(POS_REAL)-LEN(ORDEM_ELIM[1])
if ESTRUTURA [I,2] <> 'M'
? "I",I,"LEN(POS_REAL)",LEN(POS_REAL),"LEN(ORDEM_ELIM[1])",LEN(ORDEM_ELIM[1]) // linhas provisórias pra descobrir error base/1132 array access
? "ESTRUTURA [I,2]",ESTRUTURA [I,2] // linhas provisórias pra descobrir error base/1132 array access
? "MASC_CAMPOS[POS_REAL]",MASC_CAMPOS[POS_REAL] // linhas provisórias pra descobrir error base/1132 array access
INKEY(0) // linhas provisórias pra descobrir error base/1132 array access
if empty(MASC_CAMPOS[POS_REAL])

=========

Se vcs verificarem no arquivo ROTINAS5.PRG verão esse mesmo local q inclusive coloquei linhas provisórias.

Grato,
Microvolution. MSN:microvolution@hotmail.com
Grato,
MICROVOLUTION - 16 anos Evoluindo Com Você!


Você já leu a Bíblia hoje?
João 3:16 - Porque Deus amou ao mundo de tal maneira que deu seu Único Filho para que todo aquele que nEle crê não pereça mas tenha a Vida Eterna!
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

VETORES ou MATRIZES em Clipper

Mensagem por Eolo »

O erro 1132 ocorre porque a expressão LEN(POS_REAL)-LEN(ORDEM_ELIM[1]) deve estar retornando um valor indevido. Esse valor tem que variar de 1 até len(ESTRUTURA).

O erro 1068 ocorre porque:
. a expressão está retornando um valor não numérico (pouco provável, já que há nela uma subtração sem erro)
. ESTRUTURA não é uma matriz ou está vazia ou não tem 2 dimensões.
. ORDEM_ELIM não é uma matriz (ou está vazia)

Exemplo:
matriz:={1,2,3} -> matriz[4] ou matriz[0] -> erro 1132
matriz:={} -> matriz vazia -> matriz[1] -> erro 1132
matriz:={1,2,3} -> expressao:="2" -> matriz[expressao] -> erro 1068
matriz:=123 -> matriz[2] -> erro 1068

Logo ANTES do for/next:
. confirme que a expressão está retornando de 1 até len(ESTRUTURA)
. confirme que o valor retornado pela expressão é numérico
. confirme que ESTRUTURA é realmente uma matriz, tem 2 dimensões e não está vazia
- idem para ORDEM_ELIM.
microvolution
Usuário Nível 5
Usuário Nível 5
Mensagens: 1231
Registrado em: 02 Set 2011 22:17
Contato:

VETORES ou MATRIZES em Clipper

Mensagem por microvolution »

// adiciona colunas a browse
for I := 1 to LEN(POS_REAL)-LEN(ORDEM_ELIM[1])
if ESTRUTURA [I,2] <> 'M'

? "I",I,"LEN(POS_REAL)",LEN(POS_REAL),"LEN(ORDEM_ELIM[1])",LEN(ORDEM_ELIM[1]) // linhas provisórias pra descobrir error base/1132 array access
? "ESTRUTURA [I,2]",ESTRUTURA [I,2] // linhas provisórias pra descobrir error base/1132 array access
wait len(masc_campos)
wait type("masc_campos")
wait len(pos_real)
wait type("pos_real")
?"depois dos 4 waits"
inkey(0)
? "MASC_CAMPOS[POS_REAL]",MASC_CAMPOS[POS_REAL] // linhas provisórias pra descobrir error base/1132 array access (linha 4856 atual)
INKEY(0) // linhas provisórias pra descobrir error base/1132 array access
if empty(MASC_CAMPOS[POS_REAL]) - era aqui q era a linha 4856, ou seja aqui q acontece o erro.
oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL],fieldblock (fieldname (POS_REAL) )))
else
NOME_CAMPO := fieldname (POS_REAL)
BLOCO := "{|XX|transform(if(XX==NIL,"+NOME_CAMPO+","+NOME_CAMPO+":= XX),'"+MASC_CAMPOS[POS_REAL]+"')}"
oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL],&(BLOCO) ))
endif
else
oTBROWSE:addcolumn (tbcolumnnew (CABEC_CAMPOS [POS_REAL],{|| '<MEMO>'}))
endif
oTBCOLUMN := oTBROWSE:getcolumn (oTBROWSE:colcount)
oTBCOLUMN:cargo := array (3)

oTBCOLUMN:Cargo[COL_TAMREL] := TAM_CAMPOS[POS_REAL]
oTBCOLUMN:Cargo[COL_MASC ] := MASC_CAMPOS[POS_REAL[I]]

oTBCOLUMN:Cargo[COL_EXP ] := fieldname (POS_REAL[I])

next I
Grato,
MICROVOLUTION - 16 anos Evoluindo Com Você!


Você já leu a Bíblia hoje?
João 3:16 - Porque Deus amou ao mundo de tal maneira que deu seu Único Filho para que todo aquele que nEle crê não pereça mas tenha a Vida Eterna!
Avatar do usuário
Eolo
Colaborador
Colaborador
Mensagens: 1134
Registrado em: 08 Dez 2005 18:24
Localização: São Paulo - SP

VETORES ou MATRIZES em Clipper

Mensagem por Eolo »

Deixar anotado pra você consertar depois. Conforme vimos, o erro tá na linha 4856 e é o seguinte: as matrizes MASC_CAMPOS e POS_REAL têm o mesmo tamanho, mas o último elemento da POS_REAL está "vazio".

Então, quando vc faz MASC_CAMPOS[POS_REAL] no último loop, dá o erro 1068, porque resulta em MASC_CAMPOS[...vazio...]. Em outras palavras, POS_REAL tem que sempre retornar um número, de 1 até o tamanho de MASC_CAMPOS.

Agora é ver onde essa matriz POS_REAL é criada (antes da linha 4856) e descobrir porque o último elemento não está sendo preenchido.
Migao
Usuário Nível 1
Usuário Nível 1
Mensagens: 17
Registrado em: 28 Out 2011 17:39
Localização: São Paulo

VETORES ou MATRIZES em Clipper

Mensagem por Migao »

Oi pessoal...

Arrays em Clipper (ou XBase++) são heterogêneos. São coleções de dados. Vc pode até convencionar linhas/colunas mas nada te obriga a isso.

Sobre esse exemplo de array :

Código: Selecionar todos

AR:={ {"NOME A","NOME B","NOME C","NOME D"},{0,1,5,8},{CTOD("01/02/2007"),CTOD("02/01/2007"),CTOD("12/04/2007"),CTOD("01/02/2007")},{" "," "," "," "} 
Eu prefiro endentar assim (que fcilita o entendimento) :

Código: Selecionar todos

AR:={ {"NOME A","NOME B","NOME C","NOME D"},
     {0,1,5,8},
     {CTOD("01/02/2007"),CTOD("02/01/2007"),CTOD("12/04/2007"),CTOD("01/02/2007")}, ;
     {" "," "," "," "}


//AR[1] : É UM ARRAY : {"NOME A","NOME B","NOME C","NOME D"}
//AR[1,1] : É O PRIMEIRO NOME DO PRIMEIRO ARRAY (NOME A)

//AR[2] : TAMBÉM É UM ARRAY
//AR[2,2] : É O SEGUNDO ELEMENTO DESSE ARRAY : 1

//AR[3] : DE NOVO UM ARRAY
//AR[3,3] : É UMA DATA : CTOD("12/04/2007")

//AR[4] : OUTRO ARRAY
//AR[4,2] : EM BRANCO


Me parece que esse exemplo é tipo um Banco de Dados jogado em Array....

Pra correr os itens do array eu faria assim :

Código: Selecionar todos


LOCAL LNI, ;
      LNT

LNT:=LEN(AR[1])

FOR LNI:=1 TO LNT
  ? "NOME : ",AR[1,LNI]
  ? "NRO  : ",AR[2,LNI]
  ? "DATA : ",AR[3,LNI]
  ? "BRANC: ",AR[4,LNI]
NEXT


Mas pra arrays emulando bancos de dados (tabelas). eu particularmente prefiro montar vários
arrays, um pra cada coluna do Banco de Dados. Fica muito mais simples de trabalhar :

Código: Selecionar todos

ARNOME   :={"NOME A","NOME B","NOME C","NOME D"}
ARNUMEROS:={0,1,5,8}
Inclusive, se precisar adicionar (ou retirar) campos da tabela, vc não mexe na lógica...

Mas eu uso sim (e muito) arrays heterogêneos. São fantásticos. Tenho casos inclusive onde os elementos do array são strings que contèm Macros ! Ou code blocks.

Pra quem táh começando a fuçar nos Arrays Heterogêneos, tenho uma função muito legal (que serve não só pra array) que chama ANYTOC (AnyThingToChar). Ela converte qq coisa pra Char, inclusive Arrays. Montei ela de forma recursiva (ela chama a si mesmo). Tem duas variações : ANYTOC simples e ANYTOCED (ed no final de editado). Uso mais a ANYTOCED.

No caso, quando estou "perdido" num array muito complexo, eu simplesmente faço ?

? ANYTOCED(array_complexo)

Ou ainda melhor assim :

STRFILE(ANYTOCED(array_complexo),"C:\TEMP\DUMP.TXT") // STRFILE É DA CA TOOLS III, muito prática.

Código: Selecionar todos

# IFDEF __WIN32__
#       INCLUDE "SET.CH"
# ENDIF

FUNCTION ANYTOC(LXVAR)

LOCAL LNI, ;
      LNT, ;
      LCLINHA:="", ;
      LCVALTYPE:=VALTYPE(LXVAR)

IF      LCVALTYPE == "A"
        LCLINHA+="{"
        LNT:=LEN(LXVAR)
        FOR LNI:=1 TO LNT
          LCLINHA+=ANYTOC(LXVAR[LNI])
        NEXT
        LCLINHA+="}"
ELSEIF  LCVALTYPE == "C"
        LCLINHA+=LXVAR
ELSEIF  LCVALTYPE == "N"
        LCLINHA+=ALLTRIM(STR(LXVAR))
ELSEIF  LCVALTYPE == "D"
        LCLINHA+=DTOC(LXVAR)
ELSEIF  LCVALTYPE == "L"
        LCLINHA+=IIF(LXVAR,".T.",".F.")
ELSEIF  LCVALTYPE == "U"
        LCLINHA+="U"
#IFDEF __XPP__
ELSEIF  LCVALTYPE IN "B,M,O"
        LCLINHA+=VAR2CHAR(LXVAR)
#ENDIF
ELSE
        LCLINHA+="(VARIAVEL TIPO " + LCVALTYPE + ")"
END IF

RETURN LCLINHA


FUNCTION ANYTOCED(LXVAR)

STATIC SLNINDELNT:=0, ;
       SNNIVEL:=0

# DEFINE SEPARADOR CHR(255)

LOCAL LNI, ;
      LNT, ;
      LCLINHA:="", ;
      LCVALTYPE:=VALTYPE(LXVAR), ;
      LCSAIDA:=""

SNNIVEL++

IF      LCVALTYPE == "A"
        LCLINHA+=SEPARADOR + SPACE(SLNINDELNT) + "{" + SEPARADOR
        SLNINDELNT+=2
        LNT:=LEN(LXVAR)
        LCLINHA+=SPACE(SLNINDELNT)
        FOR LNI:=1 TO LNT
          LCLINHA+=ANYTOCED(LXVAR[LNI]) + IIF(LNI<LNT,",","")
        NEXT
        SLNINDELNT-=2
        LCLINHA+=SEPARADOR + SPACE(SLNINDELNT) + "}"
ELSE
        IF      LCVALTYPE == "C"
                LCLINHA   +='"' + LXVAR + '"'
        ELSEIF  LCVALTYPE == "N"
                LCLINHA   +=ALLTRIM(STR(LXVAR))
        ELSEIF  LCVALTYPE == "D"
                LCLINHA   +=DTOC(LXVAR)
        ELSEIF  LCVALTYPE == "L"
                LCLINHA   +=IIF(LXVAR,".T.",".F.")
        ELSEIF  LCVALTYPE == "U"
                LCLINHA   +="?"
#IFDEF __XPP__
ELSEIF  LCVALTYPE IN "B,M,O"
        LCLINHA           +=VAR2CHAR(LXVAR)
#ELSE
        ELSEIF  LCVALTYPE == "B"
                LCLINHA   +="{||code block}"
#ENDIF
        ELSE
                LCLINHA   +="VARIAVEL TIPO " + LCVALTYPE
        END IF
END IF

SNNIVEL--

LCSAIDA+=IIF(SNNIVEL == 0,STRTRAN(LCLINHA,SEPARADOR,CRLF) + CRLF,LCLINHA)

LCSAIDA:=RTRIM(LCSAIDA)

IF  SUBSTR(LCSAIDA,LEN(LCSAIDA)-1) == CRLF
    LCSAIDA:=LEFT(LCSAIDA,LEN(LCSAIDA)-2)
END IF

RETURN LCSAIDA
Avatar do usuário
Netavin
Usuário Nível 3
Usuário Nível 3
Mensagens: 306
Registrado em: 28 Fev 2007 08:37
Localização: Cacoal-RO

VETORES ou MATRIZES em Clipper

Mensagem por Netavin »

Caros amigos.
Possuo um módulo de cadastro onde utilizo For ... next para as inclusões. O número de inclusões é determinado por uma variável que indica quantos cadastros farei.
Isso é possível com matrizes ? Caso positivo, como proceder para finalizar as inclusões?

Grato!

Netavin.
TK90 / TK95 / APPLE IIe / 286 / 386 / 486 / 586 / AMD Atlhon
" Sem saber que era impossível, foi lá e fez !! "
Migao
Usuário Nível 1
Usuário Nível 1
Mensagens: 17
Registrado em: 28 Out 2011 17:39
Localização: São Paulo

VETORES ou MATRIZES em Clipper

Mensagem por Migao »

NetAvin:

Pra dar essa resposta tem que ver como é programado dentro do teu FOR/NEXT.

Mas a princípio seria possível sim.

Provavelmente vc deve ter algo com Macro ( & ) . Eu prefiro programar com Arrays. Mas uso bastante Macro também. Inclusive dá pra misturar os 2 (macro e array).

Enfim posta mais detalhes da tua aplicação pra que seja possível te ajudar blz ?

Abração,
Migão
Responder