Ajuda com código

Fórum sobre a linguagem CA-Clipper.

Moderador: Moderadores

Responder
gilsonpaulo
Usuário Nível 3
Usuário Nível 3
Mensagens: 135
Registrado em: 02 Fev 2008 11:30
Localização: Quatro Barras

Ajuda com código

Mensagem por gilsonpaulo »

Boa noite.

Alguem poderia me ajudar a otimizar este código? Acho que poderia colocar estes seek em uma unica função, mas estou patinando.

Código: Selecionar todos

	DO WHILE .T.
                CALL TSABOR
                SETCOLOR("W/B,W/B")
                @ 10,23 GET ttam PICTURE "@!KX" VALID(ttam$"PMGS")
                SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                        RETURN
                ENDIF

                IF ttam = "P"
                        @ 10,25 SAY "PEQUENA"
                ELSEIF ttam = "M"
                        @ 10,25 SAY "MEDIA"
                ELSEIF ttam = "G"
                        @ 10,25 SAY "GRANDE"
                ELSEIF ttam = "S"
                        @ 10,25 SAY "SUPER"
                ENDIF


                @ 12,05 GET csab1 PICTURE "@K 99999"
               SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                        LOOP
                ENDIF
                IF .NOT. EMPTY(csab1)
                        SELECT MER
                        GO TOP
                        SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
                        SET ORDER TO 6
                        SEEK csab1
                        IF .NOT. FOUND()
                                TONE(1000,2)
                                LOOP
                        ENDIF
                        @ 13,12 SAY DESMER
                        @ 13,45 GET tdes1 PICTURE "@KX"
                        csab2 = DESMER
                        IF PREMER > tuni
                                tuni = PREMER
                        ENDIF
                ENDIF

                @ 13,05 GET csab2 PICTURE "@K 99999"
                SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                        LOOP
                ENDIF
                IF .NOT. EMPTY(csab2)
                        SELECT MER
                        GO TOP
                        SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
                        SET ORDER TO 6
                        SEEK csab2
                        IF .NOT. FOUND()
                                TONE(1000,2)
                                LOOP
                        ENDIF
                        @ 13,12 SAY DESMER
                        @ 13,45 GET tdes2 PICTURE "@KX"
                        csab2 = DESMER
                        IF PREMER > tuni
                                tuni = PREMER
                        ENDIF
                ENDIF

                @ 14,05 GET csab3 PICTURE "@K 99999"
                SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                        LOOP
                ENDIF
                IF .NOT. EMPTY(csab3)
                        SELECT MER
                        GO TOP
                        SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
                        SET ORDER TO 6
                        SEEK csab3
                        IF .NOT. FOUND()
                                TONE(1000,2)
                                LOOP
                        ENDIF
                        @ 14,12 SAY DESMER
                        @ 14,45 GET tdes3 PICTURE "@KX"
                        csab3 = DESMER
                        IF PREMER > tuni
                                tuni = PREMER
                        ENDIF
                ENDIF

                @ 15,05 GET csab4 PICTURE "@K 99999"
                SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                        LOOP
                ENDIF
                IF .NOT. EMPTY(csab4)
                        SELECT MER
                        GO TOP
                        SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
                        SET ORDER TO 6
                        SEEK csab4
                        IF .NOT. FOUND()
                                TONE(1000,2)
                                LOOP
                        ENDIF
                        @ 15,12 SAY DESMER
                        @ 15,45 GET tdes4 PICTURE "@KX"
                        csab4 = DESMER
                        IF PREMER > tuni
                                tuni = PREMER
                        ENDIF
                ENDIF
        SET FILTER TO
        SET ORDER TO 2
        EXIT

        ENDDO
ENDIF
Desde já agradeço antecipadamente qualquer ajuda...

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

Re: Ajuda com código

Mensagem por Maligno »

Esqueceu de dizer qual é o problema.
[]'s
Maligno
---
Não respondo questões técnicas através de MP ou eMail. Não insista.
As dúvidas devem ser postadas no fórum. Desta forma, todos poderão
se beneficiar das respostas.
---
Se um dia precisar de uma transfusão de sangue você perceberá como
é importante a figura do doador. Procure o hemocentro de sua cidade e
se informe sobre a doação de sangue, plaquetas e medula óssea. Doe!
Voltar ao topo
Avatar do usuário
dbsh
Usuário Nível 3
Usuário Nível 3
Mensagens: 128
Registrado em: 14 Jul 2004 14:19
Localização: ES

Re: Ajuda com código

Mensagem por dbsh »

Se a demora estiver na busca, tire o SET FILTER, coloque sabor e tamanho no indice e faça a busca assim:

Código: Selecionar todos

SEEK csab2 + "S" + ttam
010011110010000001110011011101010110001101100101011100110111001101101111001000001110100100100000011000110110111101101110011100110111010001110010011101011110110101100100011011110010000001100001001000000110111001101111011010010111010001100101
01001101011000010111001001100011011011110111001100100000010000010110111001110100011011110110111001101001011011110010000001000100011001010010000001000010011011110110111001101001
0101010001100101011011000011101000100000001010000011001000110111001010010011100100101101001110010011100000110100001100110010110100110101001100100011100100110000
Voltar ao topo
Avatar do usuário
acelconsultoria
Usuário Nível 3
Usuário Nível 3
Mensagens: 231
Registrado em: 10 Jan 2006 17:05
Localização: Itápolis-SP

Re: Ajuda com código

Mensagem por acelconsultoria »

Bom, pelo que eu entendi, a rotina está repleta de READ's. Você pode criar GET's com um único READ, e fazer as buscas (seek) via função.

Código: Selecionar todos

DO WHILE .T.
                CALL TSABOR
                SETCOLOR("W/B,W/B")
                @ 10,23 GET ttam PICTURE "@!KX" VALID PSQ_TAM() .AND. (ttam$"PMGS")
                @ 12,05 GET csab1 PICTURE "@K 99999" VALID PSQ_FUN(1)
                @ 12,45 GET tdes1 PICTURE "@KX"
                @ 13,05 GET csab2 PICTURE "@K 99999" VALID PSQ_FUN(2)
                @ 13,45 GET tdes2 PICTURE "@KX"
                @ 14,05 GET csab3 PICTURE "@K 99999" VALID PSQ_FUN(3)
                @ 14,45 GET tdes3 PICTURE "@KX"
                @ 15,05 GET csab4 PICTURE "@K 99999" VALID PSQ_FUN(4)
                @ 15,45 GET tdes4 PICTURE "@KX"
                SET CURSOR ON
                READ
                SET CURSOR OFF
                IF LASTKEY() = 27
                    LOOP
                ENDIF
                SET FILTER TO
                SET ORDER TO 2
                EXIT
        ENDDO
ENDIF


FUNCTION PSQ_TAM()
 IF ttam = "P"
    @ 10,25 SAY "PEQUENA"
 ELSEIF ttam = "M"
    @ 10,25 SAY "MEDIA"
 ELSEIF ttam = "G"
    @ 10,25 SAY "GRANDE"
 ELSE
    @ 10,25 SAY "SUPER"
 ENDIF
RETURN .T.


FUNCTION PSQ_FUN( ARG1 )
 IF ARG1 = 1
    IF EMPTY(CSAB1 )
        RETURN .F.
    ENDIF
    SELECT MER
    DBGOTOP()
    SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
    SET ORDER TO 6
    IF !DBSEEK( CSAB1 )
        TONE(1000,2)
        RETURN .F.
    ENDIF
    @ 13,12 SAY DESMER
    Csab1 = DESMER
    IF PREMER > tuni
        tuni = PREMER
    ENDIF
ELSEIF ARG1 = 2
    IF EMPTY(CSAB2 )
        RETURN .F.
    ENDIF
    SELECT MER
    DBGOTOP()
    SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
    SET ORDER TO 6
    IF !DBSEEK( CSAB2 )
        TONE(1000,2)
        RETURN .F.
    ENDIF
    @ 13,12 SAY DESMER
    Csab2 = DESMER
    IF PREMER > tuni
        tuni = PREMER
    ENDIF
ELSEIF ARG1 = 3
    IF EMPTY(CSAB3 )
        RETURN .F.
    ENDIF
    SELECT MER
    DBGOTOP()
    SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
    SET ORDER TO 6
    IF !DBSEEK( CSAB3 )
        TONE(1000,2)
        RETURN .F.
    ENDIF
    @ 13,12 SAY DESMER
    Csab3 = DESMER
    IF PREMER > tuni
        tuni = PREMER
    ENDIF
ELSE
    IF EMPTY(CSAB4 )
        RETURN .F.
    ENDIF
    SELECT MER
    DBGOTOP()
    SET FILTER TO SABOR = "S" .AND. TAMANHO = ttam
    SET ORDER TO 6
    IF !DBSEEK( CSAB4 )
        TONE(1000,2)
        RETURN .F.
    ENDIF
    @ 13,12 SAY DESMER
    Csab4 = DESMER
    IF PREMER > tuni
        tuni = PREMER
    ENDIF
ENDIF
RETURN .T.
Eu não testei, mas creio que a idéia seja essa. Agora, não deu pra entender direito o que vc quer fazer e como estão organizados esses dados nessa sua rotina. Com uma pequena modificação, daria pra fazer com que a função PSQ_FUN() trabalhe apenas com um único DBSEEK(), utilizando macros ou argumentos.

Abraços.
Adm. Maickon Sato
Consultoria e Projetos
-------------------------------------------------------
Voltar ao topo
rbonotto
Usuário Nível 3
Usuário Nível 3
Mensagens: 253
Registrado em: 06 Mai 2005 18:52

Re: Ajuda com código

Mensagem por rbonotto »

Este é um programa para pizzarias certo ?

Eu sugeriria vc criar grupos, exemplo:

0001 pizzas
0002 calzones
0003 bebidas
e ai por diante...

então os sabores:
ex: mussarela 0025
calabresa 0022, etc...

Ao procurar faça um um seek:
ex: pizzas( grupo 0001) de calabresa (0022)
seek 0001 + 0022

Ja fiz um sistema de pizzarias, lanchonetes, etc... que teve grande aceitação ( a empresa que trabalhava vendeu um monte) e éra neste
formato: grupo + sabores

Fica rapido e eficaz,

Fica ai um "bizu" :)Pos
mixsistemas@gmail.com
Voltar ao topo
Responder

Voltar para “CA-Clipper”