Tip: Creating ProperCase strings

[PB]

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")

[ebs]

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

[Kris_a]

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

[PB]

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

Obviously not -- it works. I guess it should be illegal, though.

[oldefoxx]

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.

[Kris_a]

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

[Pupil]

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]

[blueznl]

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")

[Kris_a]

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

(ps. these tests arent very accurate )

[Pupil]

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

[blueznl]

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 

[Pupil]

(darn you, pupil, you cheat! )

Not cheating just utilizing the power of PB

[Kris_a]

Haha, this is gonna get nasty!!

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

[Dare2]

[blueznl]

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)