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) 647 veces
Última edición por jmetin2 el Vie Oct 18, 2013 2:21 am, editado 3 veces en total
:)
jmetin2
 
Mensajes: 168
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.
:)
jmetin2
 
Mensajes: 168
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) 657 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: 151
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: 151
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

wholesale china jerseys 0-24-0-24-242274 cheap nba jerseys

Notapor SUo71pnwhl » Mar May 01, 2018 12:38 am

Did your competitor do something unusual that affected your sales? Were sales volumes affected by some natural, social or political event? Did disruptions in the distribution system lead to a drop in sales? Did sales surge because of promotional schemes or sales incentives? These are just a few cases where some exceptional situation or factor may have affected the sales.

cheap china jerseys When Keystone looked blocked, the Conservative Government of Canada moved into talks with the Pan Pacific Trade Agreement, removing protections on NAFTA traded goods to push bitumen overseas to be refined in China. Strava doesn really care so much about sports other than cycling and running. cheap china jerseys

As for college basketball specifically, Syracuse holds the strongest following from upstate NY all the way to Manhattan and long island. Whether or not you offer incentives is, obviously, up to you. US's rail CEOs gets paid even less, but their experience is more on continental railway, not urban rail transit system..

cheap jerseys china "Microtargeting" of content is really interesting. It not as simple as "Well just do these other kinds of problems instead" writing and grading those problems would easily take 30 hours a week that I don have. Murray, who held the No. I have a friend who spent an entire year on a similar problem.. cheap football jerseys

wholesale nfb jerseys Sorry, but it frustrating. Another little known, but great inventor was a young man name Jan Ernst Matzeliger (1852 1889) who invented a shoemaking machine that increased shoemaking speed by 900%. So America, Canada, Great Britain, New Zealand and Australia are all sitting at the bar having drinks, with France and Germany sitting on the edges of the group. wholesale nfb jerseys

I was wearing myself out pushing around a heavy, petrol driven machine and so decided to call in some help.. I take a 2nd lighter because two BIC lighters with a few feet of guerilla tape wrapped around each is very low weight and I had one run out of butane before, and on another trip had one that just stopped sparking but I was able to use my backup.

wholesale football jerseys The motions are not responsible of hurting the archetypes. She doesn't like what the school serves up. The Value of ExperienceSome may argue that there is no value to the experiences in the Matrix as nothing occurs in true reality. The vestments have been turned into a red, fur suit with white trimming. wholesale football jerseys

cheap nfl jerseys I can't say I was ever injured on the playing field actually, my worst "sports" injury came when somebody tripped me as I was running around the school gym but if you're somebody who takes your sports seriously, either as an amateur, a professional, or a would be professional, you owe it to yourself to guard against serious injury. cheap chian jerseys

wholesale jerseys china That's all right too we'll get to that in a bit.. That's the same standard that's applied to drug pushers, child pornographers, organized crime. Marathon bills its self as the heart of the Florida Keys. Who knows. With this rotation method, I am providing my body with a sufficient variety of nutrients and vitamins, and not overloading my body with too much of them. wholesale jerseys china

cheap jerseys wholesale The independent senator refused to reform entitlements in favor of a more fair tax tax code. One of the most delicious recipes is to add two tablespoons of dry Italian Dressing to eight ounces of cream cheese and mix it up very well. According to recent American Action Forum research, 80 percent of minimum wage workers are not actually in poverty, increasing the federal minimum to $10, as some have proposed, wouldn benefit 99 percent of the people in poverty. cheap jerseys wholesale

Meaning we're closer to the day when acceptance will be total. I don work at WalMart, so I just spitballing here, but let say there is one team leader per 10 cashiers, and 1 manager per 10 team leaders. But I knew going in that the likelihood of all 6 homes (in my case) remaining fence free was slim, so it didn really piss me off.

Of course, part of that is that people won see the increased income till 2018 tax season, but even then I don know how big of an impact it make.. I miss that place sometimes. I grew up about an hour from Steubenville. But now you got me thinking. They often brag about their child's accomplishments like other parents might, but the narcissist give strong hints that the child is as they are not due to the child's own efforts and talents, but simply due to the fantastic job that the narcissist is doing with the child.
SUo71pnwhl
 
Mensajes: 549
Registrado: Jue Abr 26, 2018 11:35 pm

Siguiente

Volver a Betas

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados

cron