Cobol Foro

Cobol Foro (https://www.cobolforo.es/index.php)
-   Fujitsu COBOL (https://www.cobolforo.es/forumdisplay.php?f=77)
-   -   [Sintaxis] Busqueda Combobox (https://www.cobolforo.es/showthread.php?t=1702)

jmeza 5 de diciembre de 2023 00:14
Busqueda Combobox
 
Hola, consulta en un combobox de pawercobov9 como podría programar la búsqueda que coincida con una parte del nombre que este en cualquier posición a lo largo de la escritura Ej: nombre de clientes.
Si alguien me puede ayudar con la rutina como hacerlo
Se lo agradezco
Saludos

Kuk 5 de diciembre de 2023 21:31
@jmeza, mira a ver, no lo he probado casi pero algo así debes hacer. Lo mismo tienes que ajustar algo:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  idx-1       pic 9(4).
  5.  01  idx-2       pic 9(4) comp-5.
  6.  
  7.  01  max         pic 9(4) comp-5.
  8.  
  9.  01  sw-enontr   pic x.
  10.      88  sw-enontr-si       value 's'.
  11.      88  sw-enontr-no       value 'n'.
  12.  
  13.  01  lineaCombo  pic x(20).
  14.  
  15.  01  buscar      pic x(20).
  16.  01  buscLength  pic 9(4) comp-5 value 0.
  17.  
  18.  
  19.  01  msg         pic x(100).
  20.  
  21.  PROCEDURE       DIVISION.
  22.  
  23.      move 'de5' to buscar
  24.      
  25.      compute buscLength = function stored-char-length(buscar)
  26.      
  27.      move 1 to idx-1
  28.      move "ListCount" OF CmCombo1 to max
  29.      
  30.      set sw-enontr-no to true
  31.      
  32.      perform until idx-1 > max or sw-enontr-si
  33.          move "ListString"(idx-1) OF CmCombo1 to lineaCombo
  34.          
  35.          move 1 to idx-2
  36.          
  37.          perform until idx-2 + buscLength > length of buscar or sw-enontr-si
  38.              if  lineaCombo(idx-2:buscLength) = buscar(1:buscLength)
  39.                  set sw-enontr-si to true
  40.              end-if
  41.              
  42.              add 1 to idx-2
  43.          end-perform
  44.          
  45.          if  sw-enontr-no
  46.              add 1 to idx-1
  47.          end-if
  48.      end-perform
  49.      
  50.      if  sw-enontr-si
  51.          move idx-1 to "ListIndex" OF CmCombo1
  52.          
  53.          string "Encontrado en la línea " idx-1 " del combo." 
  54.              delimited by size into msg
  55.          
  56.          INVOKE pow-self "DisplayMessage" USING msg 64
  57.      
  58.      else
  59.          INVOKE pow-self "DisplayMessage" USING "No encontrado." 64
  60.      end-if
  61.      

Fito 6 de diciembre de 2023 11:05
1 Archivos Adjunto(s)
Hola.

Acá te paso un ejemplo simple para buscar un string dentro de otro. Podés correrlo, está funcional...

Saludos

Fito...

jmeza 23 de junio de 2024 01:23
Programa Ejemplo
 
Cita:
Citación del post de Fito (Mensaje 9183)
Hola.

Acá te paso un ejemplo simple para buscar un string dentro de otro. Podés correrlo, está funcional...

Saludos

Fito...
Hola Fito
El ejemplo enviado falta un archivo que esta en el call,
da error

Código COBOL:
  1.  comienzo.
  2.      call "prgbuscar" cancel "prgBuscar".

fastpho 23 de junio de 2024 18:46
@jmeza , en el ejemplo que subio @Fito , esta el prgbuscar como un script
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  
  5.  01  palabra     pic x(20).
  6.  01  linea       pic x(100).
  7.  
  8.  01  wlen        pic s9(5) comp-5.
  9.  
  10.  01  i           pic 9(8).
  11.  01  h           pic 9(8).
  12.  01  si          pic 9(8).
  13.  
  14.  PROCEDURE       DIVISION.
  15.  
  16.  comienzo.     
  17.      move "Text" of txtPalabra        to palabra.
  18.      
  19.      compute wlen = function stored-char-length(palabra).
  20.      
  21.      move "ListCount" of cmbDatos     to h.
  22.  
  23.      move zeros                       to "ListIndex" of cmbDatos.
  24.      
  25.      move zeros                       to si.
  26.      perform varying i from 1 by 1 until i > h
  27.         move "ListString"(i) of cmbDatos    to linea
  28.         
  29.         move function upper-case(linea)     to linea
  30.         inspect linea tallying si for all palabra(1:wlen)
  31.         
  32.         if si not = zeros
  33.            move i                     to "ListIndex" of cmbDatos
  34.            exit perform
  35.         end-if
  36.      end-perform.
  37.      
  38.      exit program.
  39.      
Saludos...


La franja horaria es GMT +2. Ahora son las 14:01.

Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2026, Jelsoft Enterprises Ltd.