PureBasic Forums - English

Posted: **Mon Apr 05, 2004 3:35 am**

Code updated for 5.20+

I couldn't find any tips for this here, so here's mine... it emulates Visual
Basic's vbProperCase flag to create strings with capital letters on each
word. (I just needed it to rename some MP3 files to a neat format).

Fred, this would be a great internal command.

Code: Select all

Procedure.s ProperCase(text$)
  For r=1 To Len(text$)
    pre=Asc(LCase(Mid(text$,r-1,1)))
    cur=Asc(LCase(Mid(text$,r,1)))
    If cur>96 And cur<123 And (r=1 Or pre<97 Or pre>122)
      cur-32
    EndIf
    a$+Chr(cur)
  Next
  ProcedureReturn a$
EndProcedure

Debug ProperCase("ThIs IS a tEst")

Posted: **Mon Apr 05, 2004 1:02 pm**

PB,

Isn't

Code: Select all

Mid(text$,0,1)

illegal?
The very first pass through the loop, "pre" is set to the value of the "0th" character of the string.
I thought that positions for string functions start at 1, not 0?

I notice that the PB compiler accepts this syntax, though.
It seems that using 0 or 1 in Mid() will give you the first character of the string.

The function does come in handy, thanks!

Eric

Posted: **Mon Apr 05, 2004 1:47 pm**

You could always do this to avoid that problem :

Code: Select all

Procedure.s ProperCase(text$) 
  a$ = ucase(Mid(text$,1,1))
  For r=2 To Len(text$) 
    cur=Asc(LCase(Mid(text$,r,1))) 
    pre=Asc(LCase(Mid(text$,r-1,1))) 
     
    If cur>96 And cur<123 And (r=1 Or pre<97 Or pre>122) 
      cur-32 
    EndIf 
    a$+Chr(cur) 
  Next 
  ProcedureReturn a$ 
EndProcedure

Handy function btw

Posted: **Tue Apr 06, 2004 5:49 am**

> Isn't Mid(text$,0,1) illegal?

Obviously not -- it works.

I guess it should be illegal, though.

Posted: **Sat Apr 10, 2004 9:21 am**

Another way to approach this is to use the ReplaceString() command.

Code: Select all

Procedure.s MCase(somestr.s)
temp.s=" "+Lower(somestr)
For a=Asc("a") To Asc("z")
  olds.s=" "+Chr(a)
  news.s=" "+Chr(a+32)
  ReplaceString(temps,olds,news)
next
temps=Mid(temps,2,Len(somestr))
ProcedureReturn temps
EndProcedure

In this way, the loop only repeats 26 times, once for each letter,
regardless of the length of somestr. Putting a space at the beginning of Temps ensures that the first letter of the string is treated properly.

Posted: **Mon Apr 12, 2004 1:39 pm**

Ouch, that one's almost 8 times slower than the original

Posted: **Mon Apr 12, 2004 2:08 pm**

Kris_a wrote:Ouch, that one's almost 8 times slower than the original

Try if this is faster...

Code: Select all

Procedure.s MyCase(text.s)
  *ptr.Byte = @text
  pre.l = 32
  While *ptr\b <> 0
    If pre = 32
      pre = *ptr\b & $ff
      If pre >= 'a' And pre <= 'z'
        pre-32
        *ptr\b = pre
      EndIf
    Else
      pre = *ptr\b & $ff
      If pre >= 'A' And pre <= 'Z'
        pre+32
        *ptr\b = pre
      EndIf
    EndIf
    *ptr+1
  Wend
  ProcedureReturn text
EndProcedure

[Edit] Changed code a bit...[/Edit]

Posted: **Mon Apr 12, 2004 2:10 pm**

pupil nooooooooo!

i was doing about the same thing...

Code: Select all

Procedure.s x_propercase(s.s)
  l = Len(s)
  *p = @s
  n = 0
  f = 1
  While n < l
    b = PeekB(*p+n)
    If b = 32
      f = 1
    ElseIf f = 1 And b >= 97 And b<=122
      PokeB(*p+n,b & $DF)
      f = 0
    ElseIf f = 0 And b >= 65 And b <= 90
      PokeB(*p+n,b | $20)
      f = 0
    Else
      f = 0
    EndIf
    n = n+1
  Wend
  ProcedureReturn s
EndProcedure

Debug x_propercase("ThIs IS a tEst")

Posted: **Mon Apr 12, 2004 2:24 pm**

Pupil, yours is faster than the original but blueznl's is about the fastest so far

(ps. these tests arent very accurate

)

Posted: **Mon Apr 12, 2004 2:54 pm**

Ok, so i had to do one more

i'm not an asm pro so there might be things to improve yet..

Code: Select all

Procedure.s MyCase(text.s)
  !mov ebp, [esp]
  !cmp ebp, 0
  !je lbl_exitproc
  !mov ebx, 32
!lbl_loop:
  !movzx eax, byte [ebp]
  !cmp al, 0
  !je lbl_exitproc
  !cmp ebx, 32
  !jne lbl_removecapital
  !mov ebx, eax
  !cmp eax, 96
  !jle lbl_continue
  !cmp eax, 123
  !jge lbl_continue
  !sub ebx, 32
  !mov byte [ebp], bl
  !inc ebp
  !jmp lbl_loop
!lbl_removecapital:
  !mov ebx, eax
  !cmp eax, 65
  !jle lbl_continue
  !cmp eax, 90
  !jge lbl_continue
  !add ebx, 32
  !mov byte [ebp], bl
!lbl_continue:
  !inc ebp
  !jmp lbl_loop
!lbl_exitproc:
  ProcedureReturn text
EndProcedure

Posted: **Mon Apr 12, 2004 2:58 pm**

and this one is even faster

IN PUREBASIC!

(darn you, pupil, you cheat!

)

Code: Select all

Procedure.s x_propercase(s.s) 
  *p = @s 
  f = 1 
  b = PeekB(*p) 
  While b <> 0 
    If b = 32 
      f = 1 
    ElseIf f = 1 And b >= 97 And b<=122 
      PokeB(*p,b & $DF) 
      f = 0 
    ElseIf f = 0 And b >= 65 And b <= 90 
      PokeB(*p,b | $20) 
      f = 0 
    Else 
      f = 0 
    EndIf 
    *p = *p+1
    b = PeekB(*p) 
  Wend 
  ProcedureReturn s 
EndProcedure

Posted: **Mon Apr 12, 2004 3:11 pm**

blueznl wrote: (darn you, pupil, you cheat! )

Not cheating just utilizing the power of PB

Posted: **Mon Apr 12, 2004 3:28 pm**

Haha, this is gonna get nasty!!

I bet if you changed those "PokeB"s to assembly, it'd be even faster still

Posted: **Mon Apr 12, 2004 3:31 pm**

Posted: **Mon Apr 12, 2004 4:21 pm**

i was a reasonable assembly programmer once...

on the 6502

not sure if i should try my hand at it again

(wrote a fairly good centipee clone called multibug for the vic20... without an assembler! if anybody has a copy of that game i would feel *very* obliged, lost my own copy though i have a vic20 standing here since a few months)

PureBasic Forums - English

Tip: Creating ProperCase strings

Tip: Creating ProperCase strings

Another Way To Go