Cadena.prp

Aplicaciones y librerías en fase de desarrollo para compartir

Cadena.prp

Notapor jmetin2 » Sab Sep 15, 2012 2:33 am

Bueno amigos, ¿Quien no se queja de la velocidad de pauscal?, pero no es culpa del lenguaje (ni de paul, amigaso).

Pues aqui les traigo una actualización para que sus programas sean los mas rapidos y consuman muy poca memoria.

Funciones actualizadas:

ParteCad:
Código: Seleccionar todo
Proc ParteCad(Referencia Texto:Cadena, Comienzo:EnteroSig, Opcional Longit:EnteroSig=-1):Cadena
  Var LenTxt:EnteroSig
  Si (Comienzo<1) Or (Longit<(-1)) GenerarError errParamInv
  LenTxt=CadLong(Texto)
  Si (LenTxt=0) GenerarError errParamInv
  Si (Longit=-1) Longit=LenTxt-Comienzo+1
  Si (Comienzo+Longit-1>LenTxt) Or (Comienzo>LenTxt) GenerarError errParamInv
  Resultado=RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Resultado)+Comienzo-1,Longit)
FinProc


IzquierdaCad:
Código: Seleccionar todo
Proc IzquierdaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Si (Longit<1) Devolver ""
  Si (CadLong(Texto)<=Longit) Devolver Texto
  Resultado = RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Texto),Longit)
FinProc


DerechaCad:
Código: Seleccionar todo
Proc DerechaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Var LenTxt:Entero
  Si (Longit<1) Devolver ""
  LenTxt=CadLong(Texto)
  Si (LenTxt<=Longit) Devolver Texto
  Resultado = RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Texto)+LenTxt-Longit,Longit)
FinProc


CadenaDeMatrizByte:
Código: Seleccionar todo
Proc CadenaDeMatrizByte(Referencia ByteAry[]:Byte):Cadena
  Var LenTxt:EnteroSig
  LenTxt=LongMat(ByteAry)
  Si LenTxt<1 Salir
  Resultado=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Resultado),ByteAry@,LenTxt)
FinProc


CadenaDePtrCad:
Código: Seleccionar todo
Proc CadenaDePtrCad(PtrCad:Entero):Cadena
  Var LenTxt:EnteroSig
  LenTxt=lstrlenptr(PtrCad)
  Si LenTxt<1 Salir
  Resultado=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Resultado),PtrCad,LenTxt)
FinProc


RepCarac:
Código: Seleccionar todo
Privado:
   Estruc RepCaracFn,X[]:byte
Público:
Proc RepCarac(bByte:Byte,dwRep:Entero):Cadena
   Var X:RepCaracFn,n:entero,@Temp:Cadena
   Redim X.X, dwRep
   Contar n=0 a Límite(X.X);X.X[n] = bByte;Seguir
   Temp@ = X@;Resultado = Temp;Temp@ = 0;Redim X.X,0
FinProc


BuscarEnCad y BuscarEnCadInv:
Código: Seleccionar todo
Proc BuscarEnCad(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,n,LongMatch,TotLng:Entero,Busc[],Res[]:Byte,PtrLpStr:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=1
  Redim Busc,CadLong(lpMatch)
  Redim Res,CadLong(lpMatch)
  CopyMemory(Busc[0]@,CadPtr(lpMatch),LongMat(Busc))
  PtrLpStr = CadPtr(lpStr)
  Contar i = dwPos a TotLng
    CopyMemory(Res[0]@,PtrLpStr+i-1,LongMatch)
    Contar n=0 a Límite(Busc)
      Si Res[n]<>Busc[n] Salir Contar
      Si n=Límite(Busc) Devolver i
    Seguir
  Seguir
FinProc

Proc BuscarEnCadInv(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,n,LongMatch,TotLng:Entero,Busc[],Res[]:Byte,PtrLpStr:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=TotLng
  Redim Busc,CadLong(lpMatch)
  Redim Res,CadLong(lpMatch)
  CopyMemory(Busc[0]@,CadPtr(lpMatch),LongMat(Busc))
  PtrLpStr = CadPtr(lpStr)
  Contar i = dwPos a 1 Dec
    CopyMemory(Res[0]@,PtrLpStr+i-1,LongMatch)
    Contar n=0 a Límite(Busc)
      Si Res[n]<>Busc[n] Salir Contar
      Si n=Límite(Busc) Devolver i
    Seguir
  Seguir
FinProc


Pronto subire mas
Adjuntos
Cadena.prp.zip
Librería Optimizada V1.0
(8.26 KiB) 385 veces
Última edición por jmetin2 el Vie Oct 18, 2013 2:21 am, editado 3 veces en total
Imagen
jmetin2
 
Mensajes: 166
Registrado: Jue Dic 15, 2011 12:07 pm
Ubicación: Merida, Yucatan, Mexico

Sponsor


Re: Cadena.prp

Notapor Pauscal » Dom Sep 16, 2012 9:19 am

Me parece que la función BuscarEnCad se podría mejorar. La verdad no lo vi bien, pero me da la impresión que las variables X, B y C no deberían ser necesarias :roll:
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina

Re: Cadena.prp

Notapor jmetin2 » Vie Oct 18, 2013 2:10 am

Retomo este tema, espero que algún día apliques algunas de estas modificaciones amigo.

Bueno, como la función de "BuscarEnCad" no estaba del todo optimizada, subí una nueva versión.
Imagen
jmetin2
 
Mensajes: 166
Registrado: Jue Dic 15, 2011 12:07 pm
Ubicación: Merida, Yucatan, Mexico

Re: Cadena.prp

Notapor Pauscal » Sab Oct 26, 2013 7:29 pm

En aquel momento (cuando subiste la primer versión) las cadenas no se pasaban por referencia automáticamente, por lo que había que duplicar cada función (una por referencia y otra no). Ahora es posible unificar ambas funciones, por lo tanto si te tomás el trabajo de unificar las funciones (es decir, modificar las funciones existentes en lugar de agregar nuevas funciones (a menos que sean funciones que hacen algo nuevo)), entonces lo puedo agregar a la biblioteca estándar. Lo importante es que tus funciones sean compatibles hacia atras, es decir que los programas que usan estas funciones de cadena sigan compilando y funcionando correctamente al utilizar las nuevas funciones.
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina

Re: Cadena.prp

Notapor Joe3 » Mié Nov 27, 2013 9:20 am

jmetin2 y Pauscal:

Unifique las mejoras que realizo jmetin2 sobre las funciones en cadenas y ademas agregue algunas funciones
que encontré en el repositorio de pauscal-compiler que no estaban en la biblioteca de cadenas.

Esta es la biblioteca con todas las funciones:
Código: Seleccionar todo
Importar "Declare.prp"

$ADV-
$EBC-

Const CrLf=#13#10
Const Null=#0

Proc CadPtr(Referencia lpStr:Cadena):Entero
  Var @Dir:Entero
  Dir@=lpStr@
  Resultado=Dir
FinProc

Proc CadLong(Referencia lpStr:Cadena):Entero
  Var @Ptr,Ret:Entero

  Ret=CadPtr(lpStr)
  Si (Ret=0) Salir
  Ptr@=Ret-4
  Resultado=Ptr
FinProc


Proc CadMayus(Referencia lpStr:Cadena):Cadena
  CharUpperBuff(lpStr,CadLong(lpStr))
  Resultado=lpStr
FinProc


Proc CadMinus(Referencia lpStr:Cadena):Cadena
  CharLowerBuff(lpStr,CadLong(lpStr))
  Resultado=lpStr
FinProc


Proc Ascii(Referencia lpStr:Cadena):Byte
  Var i:Entero,@Ret:Byte
  Si (CadLong(lpStr))
    Ret@=CadPtr(lpStr)
    Resultado=Ret
  FinSi
FinProc


Proc Carac(bByte:Byte):Cadena
  Var Temp:Cadena, @Ptr:Byte
  Temp="c"
  Ptr@=CadPtr(Temp)
  Ptr=bByte
  Resultado=Temp
FinProc


Proc CadEnt(Referencia lpStr:Cadena):EnteroSig
  Var Temp:Cadena, LenCad:Entero, Num:EnteroSig
  LenCad=CadLong(lpStr)
  Temp=RepCarac(0,(LenCad+1)*2)
  MultiByteToWideChar(0,0,lpStr,LenCad,Temp,LenCad*2)
  Si (VarI4FromStr(Temp,0,0,Num)) GenerarError errTipoIncompatible
  Resultado=Num
FinProc


Proc EntCad(lNum:EnteroSig):Cadena
  Var Temp,Res:Cadena, LenCad:Entero
  $CED-
  'la función EntStr requiere un puntero a la variable de cadena, no a la
  'cadena en sí, por eso deshabilitamos el modificador $CED
  VarBstrFromI4(lNum,0,0,Temp)
  $CED  'lo rehabilitamos
  LenCad=CadLong(Temp)\2
  Res=RepCarac(32,LenCad)
  WideCharToMultiByte(0,0,Temp,-1,Res,LenCad,Nulo,Nulo)
  Resultado=Res
FinProc

Proc CadReal(Referencia lpStr:Cadena):Real
  Var Temp:Cadena, LenCad:Entero, Num:Real
  LenCad=CadLong(lpStr)
  Temp=RepCarac(0,(LenCad+1)*2)
  MultiByteToWideChar(0,0,lpStr,LenCad,Temp,LenCad*2)
  Si (VarR8FromStr(Temp,0,0,Num)) GenerarError errTipoIncompatible
  Resultado=Num
FinProc


Proc RealCad(lNum:Real):Cadena
  Var Temp,Res:Cadena, LenCad:Entero
  $CED-
  'la función EntStr requiere un puntero a la variable de cadena, no a la
  'cadena en sí, por eso deshabilitamos el modificador $CED
  VarBstrFromR8(lNum,0,0,Temp)
  $CED  'lo rehabilitamos
  LenCad=CadLong(Temp)\2
  Res=RepCarac(32,LenCad)
  WideCharToMultiByte(0,0,Temp,-1,Res,LenCad,Nulo,Nulo)
  Resultado=Res
FinProc


Proc EntHex(lNum:Entero,Opcional FillWithZero:Booleano):Cadena
  Var Digit,i:Byte
  Contar i=1 a 8
    Si (lNum=0) And (FillWithZero=Falso) Salir
    Digit=lNum And &0F
    Resultado=Carac(>Digit<10?Digit+48:Digit+55)+Resultado
    lNum=lNum shr 4
  Seguir
FinProc


' ***********   Funciónes obtenidas del repositorío Pauscal Compiler (a revisar) *************

Proc HexEnt(hex:Cadena):Entero
  Var i:Byte
  Var car:Entero

    Contar i = CadLong(hex) a 1
      car = Ascii(ParteCad(hex, i))
      Si (i > 8) or (car < 48 and car > 58) or (car < 65 and car > 71) Entonces GenerarError errParamInv
      Resultado = Resultado + ((> car<65 ? car - 48 : car - 55) shr (i-1))
    Seguir
FinProc

Proc VarCyFromR8(nro:Real, Referencia cy:Decimal):Entero, "oleaut32"

Proc RealDec2(nro:Real):Decimal
        VarCyFromR8(nro, Resultado)
FinProc

Proc CadDec(txt:Cadena):Decimal
        Resultado = RealDec2(CadReal(txt))
FinProc

Proc DecCad(nro:Decimal):Cadena
        Resultado = RealCad(DecReal(nro))
FinProc

Proc EntDec(nro:EnteroSig):Decimal
        Var @temp:EnteroSig
        temp@ = Resultado@
        temp = nro
        Resultado = Resultado * 10000
FinProc

Proc DecEnt(nro:Decimal):EnteroSig
        Var @temp:Decimal
        Var da[]:EnteroSig
        da=[0,0]
        temp@ = da[0]@
        temp = nro/10000
        Resultado = da[0]
FinProc

Proc ReemplazarEnCadena(Referencia texto:Cadena, Referencia valores[]:Cadena)
   Var i,pos,pos2:EnteroSig
   Var match:Cadena
   
   Contar i = 0 a LongMat(valores)-1
      match = "{" + EntCad(i) + "}"
      Repetir
         pos = BuscarEnCad(texto, match)
         Si pos = 0 Entonces Salir Repetir
         pos2 = pos+CadLong(match)
         texto = IzquierdaCad(texto, pos-1) + valores[i] + _
            (> pos2 <= CadLong(texto) ? ParteCad(texto, pos2) : "")
      PorSiempre
   Seguir
FinProc

'*********************************************************************************************


'*********************************************** Mejoras por jmetin2 *************************
' Función RepCarac con mejoras de jmetin2
Privado:
   Estruc RepCaracFn,X[]:byte
   
Público:
Proc RepCarac(bByte:Byte,dwRep:Entero):Cadena
   Var X:RepCaracFn,n:entero,@Temp:Cadena
   Redim X.X, dwRep
   Contar n=0 a Límite(X.X);X.X[n] = bByte;Seguir
   Temp@ = X@;Resultado = Temp;Temp@ = 0;Redim X.X,0
FinProc

' Función ParteCad con mejoras de jmetin2
Proc ParteCad(Referencia Texto:Cadena, Comienzo:EnteroSig, Opcional Longit:EnteroSig=-1):Cadena
  Var LenTxt:EnteroSig
  Si (Comienzo<1) Or (Longit<(-1)) GenerarError errParamInv
  LenTxt=CadLong(Texto)
  Si (LenTxt=0) GenerarError errParamInv
  Si (Longit=-1) Longit=LenTxt-Comienzo+1
  Si (Comienzo+Longit-1>LenTxt) Or (Comienzo>LenTxt) GenerarError errParamInv
  Resultado=RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Resultado)+Comienzo-1,Longit)
FinProc

' Función IzquierdaCad con mejoras de jmetin2
Proc IzquierdaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Si (Longit<1) Devolver ""
  Si (CadLong(Texto)<=Longit) Devolver Texto
  Resultado = RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Texto),Longit)
FinProc

' Función DerechaCad con mejoras de jmetin2
Proc DerechaCad(Referencia Texto:Cadena,Longit:EnteroSig):Cadena
  Var LenTxt:Entero
  Si (Longit<1) Devolver ""
  LenTxt=CadLong(Texto)
  Si (LenTxt<=Longit) Devolver Texto
  Resultado = RepCarac(0,Longit)
  CopyMemory(CadPtr(Resultado),CadPtr(Texto)+LenTxt-Longit,Longit)
FinProc

' Función  con mejoras de jmetin2
Proc CadenaDeMatrizByte(Referencia ByteAry[]:Byte):Cadena
  Var LenTxt:EnteroSig
  LenTxt=LongMat(ByteAry)
  Si LenTxt<1 Salir
  Resultado=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Resultado),ByteAry@,LenTxt)
FinProc

' Función  con mejoras de jmetin2
Proc CadenaDePtrCad(PtrCad:Entero):Cadena
  Var LenTxt:EnteroSig
  LenTxt=lstrlenptr(PtrCad)
  Si LenTxt<1 Salir
  Resultado=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Resultado),PtrCad,LenTxt)
FinProc


' Función BuscarEnCad con mejoras de jmetin2
Proc BuscarEnCad(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,n,LongMatch,TotLng:Entero,Busc[],Res[]:Byte,PtrLpStr:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=1
  Redim Busc,CadLong(lpMatch)
  Redim Res,CadLong(lpMatch)
  CopyMemory(Busc[0]@,CadPtr(lpMatch),LongMat(Busc))
  PtrLpStr = CadPtr(lpStr)
  Contar i = dwPos a TotLng
    CopyMemory(Res[0]@,PtrLpStr+i-1,LongMatch)
    Contar n=0 a Límite(Busc)
      Si Res[n]<>Busc[n] Salir Contar
      Si n=Límite(Busc) Devolver i
    Seguir
  Seguir
FinProc

' Función BuscarEnCadInv con mejoras de jmetin2
Proc BuscarEnCadInv(Referencia lpStr,lpMatch:Cadena,Opcional dwPos:Entero):Entero
  Var i,n,LongMatch,TotLng:Entero,Busc[],Res[]:Byte,PtrLpStr:Entero
  LongMatch=CadLong(lpMatch)
  Si (LongMatch=0) GenerarError errParamInv
  TotLng=CadLong(lpStr)-LongMatch+1
  Si (dwPos>TotLng) GenerarError errParamInv
  Si (dwPos=0) dwPos=TotLng
  Redim Busc,CadLong(lpMatch)
  Redim Res,CadLong(lpMatch)
  CopyMemory(Busc[0]@,CadPtr(lpMatch),LongMat(Busc))
  PtrLpStr = CadPtr(lpStr)
  Contar i = dwPos a 1 Dec
    CopyMemory(Res[0]@,PtrLpStr+i-1,LongMatch)
    Contar n=0 a Límite(Busc)
      Si Res[n]<>Busc[n] Salir Contar
      Si n=Límite(Busc) Devolver i
    Seguir
  Seguir
FinProc

Proc Reemplazar(Str,Match,Rep:Cadena, Opcional Pos:Entero=1):Cadena
   Var I,Y:Entero,BYT,BOT,BUFF[],RS[]:Byte
   Var P:Entero
   Var PtrS,PtrM,PtrR:Entero;Var LnS,LnM,LnR:Entero
   LnS = CadLong(Str);LnM = CadLong(Match);LnR = CadLong(Rep)
   Si Pos<1 GenerarError ErrParamInv
   Si LnM+Pos-1>LnS GenerarError ErrParamInv
   Si REP="" GenerarError ErrParamInv
   Si LnM=0 GenerarError ErrParamInv
   Si LnS=0 GenerarError ErrParamInv
   PtrS = CadPtr(Str);PtrM = CadPtr(Match);PtrR = CadPtr(Rep)
   CopyMemory(BOT@,CadPtr(Match),1)
   Redim RS,CadLong(Str)
   Contar I=Pos a LnS
      CopyMemory(BYT@,PtrS+(I-1),1) 'Se copia 1 byte al buffer
      Si BYT = BOT ' se compara el buffer con el primer caracter de busqueda
         P=P+1'Se suma que un byte es igual al byte comparado
         Si P=LnM'Si se an comparado todos los bytes de Match
            Si Límite(RS)<Y+LnR Redim Preservar RS,Y+LnR'Si el buffer creado por la inteligencia es menor se abre un poco mas
            CopyMemory(RS[Y]@,PtrR,LnR)'se copia el REP a la cadena
            Y=Y+LnR'Se suman los bytes agregados
            P=0'Se deja en 0 los bytes comparados
            CopyMemory(BOT@,PtrM+P,1)'Se copia el primer byte al buffer BOT
         Sino'Si aun no se an comparado todos
            Si I=LnS'Pero ya se a terminado la cadena
               Redim Preservar RS,LongMat(RS)+P'se agranda el resultado
               CopyMemory(RS[Y]@,PtrS+(I-1)-P,P)'se copia los bytes que estaban a la espera
               Y=Y+P'se suman los bytes agregados
               P=0'Se pone en 0
            FinSi
               CopyMemory(BOT@,PtrM+P,1)
         FinSi
      Sino'Si los bytes no son iguales
         Si P>0' y si ay algun tipo de bufer
            Si Límite(RS)<=Y+P Redim Preservar RS,Y+P'si no el resultado no es suficiente se agregan los datos del buffer desperdisiado
            CopyMemory(RS[Y]@,PtrS+(I-1)-P,P)'se agrega el buffer desperdisiado
            Y=Y+P'Se agregan los bytes agregados
            P=0'Muy importante, se borran los datos
         FinSi
         Si Límite(RS)<=Y Redim Preservar RS,Y+(LnM)'si el buffer resultado es pqueño se agranda un tanto mas del tamaño de Match
         RS[Y]=BYT'Se agrega el byte
         Y=Y+1'Se agrega el byte agregado
      FinSi
   Seguir
   Si LongMat(RS)>Y'Si el Buffer resultado es mayor a los bytes totales
      Devolver ParteCad(CadenaDeMatrizByte(RS),1,Y)'Se corta la cadena
   Sino
      Devolver CadenaDeMatrizByte(RS)'Sino por logica sera igual el buffer al total de bytes y por eso solo se convierte
   FinSi
FinProc

'*********************************************************************************************


Proc TruncarCadena(Referencia lpStr:Cadena):Cadena
  Var Pos:Entero
  Pos=BuscarEnCad(lpStr,Null)
  Si (Pos=0) Devolver lpStr
  Si (Pos=1) Salir
  Resultado=IzquierdaCad(lpStr,Pos-1)
FinProc


Proc Separar(Referencia Texto,Sep:Cadena, Opcional PosInicio:Entero=1, Opcional MaxRet:Entero):Cadena[]
  Var Pos,Ret,Mx,SepLen,TxtLen:Entero
  SepLen = CadLong(Sep)
  Si (SepLen = 0) GenerarError errParamInv
  TxtLen = CadLong(Texto)
  Borrar Resultado
  Repetir
    Ret = BuscarEnCad(Texto,Sep,Pos+1)
    Si (Ret=0) Salir Repetir
    Redim Preservar Resultado, Mx + 1
    Resultado[Mx] = ParteCad(Texto,Pos+1,Ret-Pos-1)
    Pos = Ret + SepLen - 1
    Mx = Mx + 1
    Si (MaxRet) Si (Mx = MaxRet) Salir Repetir
    Si (Pos>=TxtLen) Salir Repetir
  PorSiempre
  Redim Preservar Resultado, Mx + 1
  Resultado[Mx] = > (Pos>=TxtLen) ? ("") : (ParteCad(Texto,Pos+1))
FinProc


Clase pscCadenas, _
  Buff[]:PSCCADENASINFO, _
  MaxBuff,iHwnd:Entero

Público:
  ClaseVar Eventos:PSCCADENAS_EVENTINFO

Privado:
  Proc evCambiar()
    Si (Eventos.AlCambiar@) Eventos.AlCambiar(hWnd,0)
  FinProc
  Proc evAdd(Pos:EnteroSig)
    Si (Eventos.AlAgregar@) Eventos.AlAgregar(hWnd,Pos)
  FinProc
  Proc evDel(Pos:EnteroSig)
    Si (Eventos.AlQuitar@) Eventos.AlQuitar(hWnd,Pos)
  FinProc
  Proc EsValido(Indice:Entero)
    Si (Indice>=MaxBuff) GenerarError errParamInv
  FinProc
  Proc GetItem(Indice:Entero):Cadena
    EsValido(Indice)
    Resultado=Buff[Indice].Texto
  FinProc
  Proc SetItem(Valor:Cadena, Indice:Entero)
    EsValido(Indice)
    Buff[Indice].Texto=Valor
    evCambiar()
  FinProc
  Proc GetDato(Indice:Entero):EnteroSig
    EsValido(Indice)
    Resultado=Buff[Indice].Dato
  FinProc
  Proc SetDato(Valor:EnteroSig, Indice:Entero)
    EsValido(Indice)
    Buff[Indice].Dato=Valor
  FinProc
  Proc GetCantidad:Entero
    Resultado=MaxBuff
  FinProc
Público:
  Prop hWnd:Entero
    Lec:iHwnd
    Esc:iHwnd
  FinProp
  Prop Cantidad:Entero
    Lec:GetCantidad
  FinProp
  Prop Item:Cadena
    Lec:GetItem
    Esc:SetItem
  FinProp
  Prop Dato:EnteroSig
    Lec:GetDato
    Esc:SetDato
  FinProp
  Proc Agregar(Texto:Cadena)
    MaxBuff=MaxBuff+1
    Redim Preservar Buff,MaxBuff
    Buff[MaxBuff-1].Texto=Texto
    evAdd(MaxBuff-1)
  FinProc
  Proc Insertar(Texto:Cadena, Indice:Entero)
    Var i:Entero
    EsValido(Indice)
    Agregar("")
    Contar i=Indice+1 a MaxBuff
      Buff[i]=Buff[i-1]
    Seguir
    Buff[Indice].Texto=Texto
    evAdd(Indice)
  FinProc
  Proc Eliminar(Indice:Entero)
    Var i:Entero
    EsValido(Indice)
    MaxBuff=MaxBuff-1
    Contar i=Indice+1 a MaxBuff
      Buff[i-1]=Buff[i]
    Seguir
    Redim Preservar Buff,MaxBuff
    evDel(Indice)
  FinProc
FinClase


Si existen más, avísenme que vamos ampliando las bibliotecas.
Saludos
Adjuntos
Cadena.rar
(6.42 KiB) 390 veces
Joe3
 
Mensajes: 16
Registrado: Lun Nov 25, 2013 9:39 am
Ubicación: Montevideo - Uruguay

Re: Cadena.prp

Notapor ErikH » Sab Nov 30, 2013 9:32 pm

Joe3 escribiste:jmetin2 y Pauscal:

Unifique las mejoras que realizo jmetin2 sobre las funciones en cadenas y ademas agregue algunas funciones
que encontré en el repositorio de pauscal-compiler que no estaban en la biblioteca de cadenas.

Esta es la biblioteca con todas las funciones:
Código: Seleccionar todo
' Función RepCarac con mejoras de jmetin2
Privado:
   Estruc RepCaracFn,X[]:byte
   
Proc RepCarac(bByte:Byte,dwRep:Entero):Cadena
   Var X:RepCaracFn,n:entero,@Temp:Cadena
   Redim X.X, dwRep
   Contar n=0 a Límite(X.X);X.X[n] = bByte;Seguir
   Temp@ = X@;Resultado = Temp;Temp@ = 0;Redim X.X,0
FinProc

Proc CadenaDeMatrizByte(Referencia ByteAry[]:Byte):Cadena
  Var LenTxt:EnteroSig
  LenTxt=LongMat(ByteAry)
  Si LenTxt<1 Salir
  Resultado=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Resultado),ByteAry@,LenTxt)
FinProc




Estoy casi seguro que ese ByteAry@ no apunta a donde deberia, y le falta su contraparte MatrizByteDeCadena.
Ese RepCarac se me hace familiar
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 150
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Re: Cadena.prp

Notapor Joe3 » Dom Dic 01, 2013 10:36 am

Como te sientes para ajustarlo??
Joe3
 
Mensajes: 16
Registrado: Lun Nov 25, 2013 9:39 am
Ubicación: Montevideo - Uruguay

Re: Cadena.prp

Notapor ErikH » Dom Dic 01, 2013 11:32 pm

Joe3 escribiste:Como te sientes para ajustarlo??


Aqui lo tienes

Código: Seleccionar todo
Proc CadenaDeMatrizByte(ByteAry[]:Byte):Cadena
  Var Temp:Cadena, LenTxt:EnteroSig
  LenTxt=LongMat(ByteAry)
  Si LenTxt<1 Salir
  Temp=RepCarac(0,LenTxt)
  CopyMemory(CadPtr(Temp),ByteAry[0]@,LenTxt)
  Resultado=Temp
FinProc

Proc MatrizByteDeCadena(Txt:Cadena):Byte[]
  Var LenTxt:EnteroSig
  Var ByteAry[]:Byte
  LenTxt=CadLong(Txt)
  Si LenTxt<1 Salir
  Redim ByteAry,LenTxt
  CopyMemory(ByteAry[0]@,CadPtr(Txt),LenTxt)
  Resultado=ByteAry
FinProc
ImagenEntrá a la wiki en OpenShift
Colofox!!!!
ErikH
 
Mensajes: 150
Registrado: Jue Nov 29, 2007 11:24 pm
Ubicación: Algún lugar de México

Re: Cadena.prp

Notapor Pauscal » Mié Dic 11, 2013 9:56 pm

Algo muuuy importante que le falta a la biblioteca de Pauscal son tests, es decir "programitas" que prueben las diferentes funciones y clases. Por ejemplo ahora, ¿cómo sabemos que las mejoras no van a romper los programas ya hechos en Pauscal? (ni hablar de cómo estamos seguros que todas las funciones andan bien :lol: )
Si este proyecto te parece útil, aceptamos donaciones en Bitcoins: 1FdnaaQyVDqmhsJZw9gk41M3zUsJrDY7Hj
Pauscal
Jefe
 
Mensajes: 439
Registrado: Mar Nov 20, 2007 9:41 pm
Ubicación: Paraná, Entre Ríos, Argentina


Volver a Betas

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado

cron