It is currently Mon Dec 09, 2019 11:22 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 55 posts ]  Go to page 1, 2, 3, 4  Next
Author Message
 Post subject: Format string with some values like sprintf (C) - Update
PostPosted: Sun Apr 20, 2008 11:23 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2053
Location: Germany
Hi,

An auxiliary function for strings as sprintf. All values byref hand over. Values can be handed over up to 11.

Update v2.01
- complete new code
- change syntax for hex
- new syntax for string
- no truncate results

Update v2.02
- Bugfix: hex values from args

Update v2.03
- Bugfix: hex type

Update v2.05
- Optimize code: Thanks to peterb
- added character

Update v2.06
- change: check hex value (pcfreak)
- added: null character '\0'

Update v2.07
- added: unsigned byte
- added: unsigned word
- added: character '\%'
- change: remove most peek functions

Update v2.08
- Removed null character '\0' (It does not work)

Update v2.09
- Fixed compiler option Purifier

Code:
;-TOP
; Comment       : Formatierung von Strings und Werte
; Author        : mk-soft, Germany
; Second Author : peterb, Czech Republic
; File          : Format.pb
; Version       : 2.09
; Create        : 10.04.2008
; Update        : 18.07.2018
;
; Compilermode  :
;
; ***************************************************************************************

; Syntax:
;
; %[flags][width][.precision]specifier
;
; Flags:
;   -         Left-justify within the given field width; Right justification is the default
;   +         Forces to preceed the result with a plus or minus sign (+ or -) even for positive numbers
;   '[char]   Fill Character; Space is the default
;
; With:
;   [Number]  Minimum number of characters To be printed. If the value To be printed is shorter than this number, the result is padded With blank spaces
;             The value is not truncated even if the result is larger.
;
; Precision:
;   [Number]  For float and Double specifiers: this is the number of digits to be printed after the decimal point
;             For string specifiers: truncate string
;             For hexnumber: defined input value; 2 = byte, 4 = word; 8 = dword; 16 = qword
;             
; Specifier:
;   b         Byte
;   a         Unsigned byte
;   w         Word
;   u         Unsigned word
;   l         Long
;   q         Quat
;   i         Integer
;   f         Float
;   d         Double
;   X         Hex; Uppercase character
;   x         Hex; Lowercase character
;   s         String
;   c         Char; value as integer

; EnableExplicit

Structure udtAny
  StructureUnion
    a.a
    b.b
    c.c
    w.w
    u.w
    l.l
    i.i
    f.f
    d.d
    q.q
  EndStructureUnion
EndStructure

Procedure.s Format ( text.s, *value1 = 0, *value2 = 0, *value3 = 0, *value4 = 0, *value5 = 0, *value6 = 0, *value7 = 0, *value8 = 0, *value9 = 0, *value10 = 0, *value11 = 0 )

  Protected *args.integer, *value.udtAny, param_align
  Protected result.s, help.s
  Protected *text.character
  Protected IsValue, IsString, IsLeft, IsVZ, IsNum2, SetFill.s, num1, num2
 
  ; Check parameter align because compiler option Purifier
  param_align = @*value2 - @*value1
 
  *args  = @*value1
  *text = @text

  Repeat
    Select *text\c
      Case 0
        Break
      Case '\'
        *text + SizeOf ( character )
        Select *text\c
          Case 0   : Break
          Case '\' : result + "\"
          Case 'n' : result + #LF$
          Case 'r' : result + #CR$
          Case 't' : result + #HT$
          Case 'v' : result + #VT$
          Case 39  : result + #DQUOTE$ ; (')
          Case 'a' : result + #BEL$
          Case 'b' : result + #BS$
          Case 'f' : result + #FF$
          Case '[' : result + #ESC$
          Case '%' : result + "%"
                 
        EndSelect
        *text + SizeOf ( character )
     
      Case '%'
        help     = "?"
        IsValue = #False
        IsString = #False
        IsLeft = #False
        IsVZ   = #False
        IsNum2 = #False
        SetFill = " "
        num1    = 0
        num2    = 0
        *text   + SizeOf ( character )
        *value  = *args\i ; get pointer to value

        Repeat
       
          Select *text\c
            Case 0   : Break
            Case '-' : IsLeft = #True
            Case '+' : IsVZ   = #True
            Case '.' : IsNum2 = #True
            Case '%' : result + "%" : *text + SizeOf ( character ) : Break
            Case 39  : *text + SizeOf ( character ) : If *text\c = 0 : Break : Else : SetFill = Chr(*text\c) : EndIf
            Case '0' To '9'
              If IsNum2 : num2 = num2 * 10 + *text\c - 48 : Else : num1 = num1 * 10 + *text\c - 48 : EndIf
             
            Case 'a'
              If *value : help = Str ( *value\a ) : EndIf : IsValue = #True
             
            Case 'b'
              If *value : help = Str ( *value\b ) : EndIf : IsValue = #True
             
            Case 'u'
              If *value : help = StrU ( *value\u, #PB_Word ) : EndIf : IsValue = #True
             
            Case 'w'
              If *value : help = Str ( *value\w ) : EndIf : IsValue = #True
             
            Case 'l'
              If *value : help = Str ( *value\l ) : EndIf : IsValue = #True
             
            Case 'q'
              If *value : help = Str ( *value\q ) : EndIf : IsValue = #True
             
            Case 'i'
              If *value : help = Str ( *value\i ) : EndIf : IsValue = #True
             
            Case 'f'
              If *value : help = StrF ( *value\f, num2 ) : EndIf : IsValue = #True
             
            Case 'd'
              If *value : help = StrD ( *value\d , num2 ) : EndIf : IsValue = #True
             
            Case 's'
              If *value : help =  PeekS ( *value ) : EndIf
              If num2   : help = Left ( help, num2 ) : EndIf : IsString = #True
             
            Case 'c'
              If *value : help = Chr ( *value\i ) : EndIf : IsString = #True
             
            Case 'X', 'x'
              If num2 = 0 : num2 = num1 : EndIf
              If *value
                Select num2
                  Case 0 To 2  : help = RSet ( Hex ( *value\b, #PB_Byte), num2, "0" )
                  Case 3 To 4  : help = RSet ( Hex ( *value\w, #PB_Word), num2, "0" )
                  Case 5 To 8  : help = RSet ( Hex ( *value\l, #PB_Long), num2, "0" )
                  Default      : help = RSet ( Hex ( *value\q, #PB_Quad), num2, "0" )
                EndSelect
              EndIf
              If *text\c = 'x' : help = LCase ( help ) : EndIf
              IsString = #True
             
            Default
              IsString = #True
             
          EndSelect
         
          If IsValue And IsVZ
            If Left ( help, 1 ) <> "-"
              help = "+" + help
             
            EndIf
          EndIf
         
          *text + SizeOf(character)
         
          If IsString Or IsValue
            If num1 And Len ( help ) < num1
              If IsLeft
                result + LSet ( help, num1, SetFill )
              Else
                result + RSet ( help, num1, SetFill )
              EndIf
            Else
              result + help
            EndIf
            *args + param_align
            Break
          EndIf
         
        ForEver
       
      Default
        result + Chr    ( *text\c   )
        *text  + SizeOf ( character )
       
    EndSelect
   
  ForEver
 
  ProcedureReturn result
   
EndProcedure


GT :wink:

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Last edited by mk-soft on Wed Jul 18, 2018 11:22 pm, edited 18 times in total.

Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 20, 2008 11:30 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Wed Oct 29, 2003 4:35 pm
Posts: 10525
Location: Beyond the pale...
Nice idea. Thanks. :)

_________________
I may look like a mule, but I'm not a complete ass.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 20, 2008 1:16 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Jun 09, 2003 10:08 pm
Posts: 665
Location: Nottingham
FYI
Code:
Mid(result, pos2 + 1, Len(result))
can be replaced by
Code:
Mid(result, pos2 + 1)
in the current PB beta version.

_________________
Anthony Jordan


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Sun Apr 20, 2008 5:19 pm 
Offline
Addict
Addict

Joined: Wed Aug 24, 2005 8:39 am
Posts: 2736
Location: Southwest OH - USA
Very nice :D

Thanks.

cheers


Top
 Profile  
Reply with quote  
 Post subject: Optimized code
PostPosted: Sat Apr 26, 2008 11:11 pm 
Offline
User
User

Joined: Sun Oct 02, 2005 8:55 am
Posts: 60
Location: Czech Republic
Optimized code :twisted: :arrow:

Code:


;-TOP
; Comment       : Formatierung von Strings und Werte
; Author        : mk-soft
; Second Author :
; File          : Format.pb
; Version       : 1.01
; Create        : 10.04.2008
; Update        : 19.04.2008
;
; Compilermode  :
;
; ***************************************************************************************

Macro __Format__(text, max)
  If max
    If max < 0
      max = ~max
      max + 1
      If Len(text) <= max
        text = LSet(text, max, " ")
      EndIf
    Else
      If Len(text) <= max
        text = RSet(text, max, " ")
      EndIf
    EndIf
  EndIf
EndMacro



Procedure.s Format(text.s, *value1 = 0, *value2 = 0, *value3 = 0, *value4 = 0, *value5 = 0, *value6 = 0, *value7 = 0, *value8 = 0, *value9 = 0, *value10 = 0, *value11 = 0)

  Protected zeiger, *value, pos1, pos2, len1, len2, exit
  Protected type, result.s, help.s, Format.s
  Protected is_op = #False
 
  zeiger = @*value1
  result = text
 
  Repeat
    pos1 = FindString ( result, "%", pos1 )
    If pos1
      *value = PeekL ( zeiger )
      pos2 = pos1 + 1
      exit = #False
      Repeat
        type = Asc ( Mid ( result, pos2, 1 ) )
       
        is_op = #False
        Select type
          Case 98, 119, 108, 113, 102, 100, 115 ; "b", "w", "l", "q", "f", "d", "s"
            Format = Mid ( result, pos1 + 1, pos2 - pos1 - 1 )
            len1   = Val ( StringField ( Format, 1, "." ) )
            len2   = Val ( StringField ( Format, 2, "." ) )
            is_op  = #True
        EndSelect
       
        Select type
          Case 98  : help = Str  ( PeekB ( *value ) )       ; "b"
          Case 119 : help = Str  ( PeekW ( *value ) )       ; "w"
          Case 108 : help = Str  ( PeekL ( *value ) )       ; "l"
          Case 113 : help = StrQ ( PeekQ ( *value ) )       ; "q"
          Case 102 : help = StrF ( PeekF ( *value ), len2 ) ; "f"
          Case 100 : help = StrD ( PeekD ( *value ), len2 ) ; "d"
          Case 115 : help =        PeekS ( *value )         ; "s"
          Case 37  : help = "%" : result = Left ( result, pos1 - 1 ) + Mid ( result, pos2 ) ; "%"
          Case 43, 45, 46, 48 To 57 : pos2 + 1; "-","+",".","0","1","2","3","4","5","6","7","8","9"
          Default : exit = #True
        EndSelect
       
        If is_op = #True
          __Format__( help, len1 )
          result = Left ( result, pos1 - 1 ) + help + Mid ( result, pos2 + 1 )
          zeiger + 4
          exit = #True
        EndIf
       
      Until exit
      pos1 + Len ( help )
    Else
      Break
    EndIf
  ForEver
 
  ProcedureReturn result
 
EndProcedure

; ***************************************************************************************

; Test

name.s = "Michael"
alter.l = 99
Debug Format("Mein Name ist %20s und ich bin %l Jahre alt", @name, @alter)
Debug Format("Mein Name ist %-20s und ich bin %l Jahre alt", @name, @alter)

wert.f = 20.55
wert2.d = -12.12
Debug Format("Wert 1 = %8.2f%%, Wert 2 = %12.4d", @wert, @wert2)

tabelle.s = "Adressen"
plz = 20444

Debug format("Select * From %s Where Plz = %l", @tabelle, @plz)

:twisted: :twisted:


Top
 Profile  
Reply with quote  
 Post subject: Re: Format string with some values like sprintf (C)
PostPosted: Sat Apr 26, 2008 11:15 pm 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Sun Apr 27, 2003 4:41 pm
Posts: 1661
Location: Germany
Nice, thanks for sharing!


BTW, there's an "n" missing:
Code:
; Comment       : Formatierung von Strings und Werte*n*

;)

_________________
Good programmers don't comment their code. It was hard to write, should be hard to read.


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu May 01, 2008 11:48 am 
Offline
Addict
Addict
User avatar

Joined: Fri May 12, 2006 6:51 pm
Posts: 2053
Location: Germany
@peterb,

thanks for optimized :wink:

Update v1.02

Added:
\n : #LF$
\r : #CR$
\t : #TAB$
\\ : "\"

Bugfix:
Code:
;-TOP
; Comment       : Formatierung von Strings und Werte
; Author        : mk-soft, Germany
; Second Author : peterb, Czech Republic
; File          : Format.pb
; Version       : 1.02
; Create        : 10.04.2008
; Update        : 19.04.2008
;
; Compilermode  :
;
; ***************************************************************************************

Macro __Format__(text, max)
  If max
    If max < 0
      max = ~max
      max + 1
      If Len(text) <= max
        text = LSet(text, max, " ")
      EndIf
    Else
      If Len(text) <= max
        text = RSet(text, max, " ")
      EndIf
    EndIf
  EndIf
EndMacro



Procedure.s Format(text.s, *value1 = 0, *value2 = 0, *value3 = 0, *value4 = 0, *value5 = 0, *value6 = 0, *value7 = 0, *value8 = 0, *value9 = 0, *value10 = 0, *value11 = 0)

  Protected zeiger, *value, pos1, pos2, len1, len2, exit
  Protected type, result.s, help.s, Format.s
  Protected is_op = #False
 
  zeiger = @*value1
  result = text
 
  result = ReplaceString(result, "\n", #CR$)
  result = ReplaceString(result, "\r", #LF$)
  result = ReplaceString(result, "\t", #TAB$)
  result = ReplaceString(result, "\\", "\")
 
  Repeat
    pos1 = FindString ( result, "%", pos1 )
    If pos1
      *value = PeekL ( zeiger )
      pos2 = pos1 + 1
      exit = #False
      Repeat
        type = Asc ( Mid ( result, pos2, 1 ) )
       
        is_op = #False
        Select type
          Case 98, 119, 108, 113, 102, 100, 115 ; "b", "w", "l", "q", "f", "d", "s"
            Format = Mid ( result, pos1 + 1, pos2 - pos1 - 1 )
            len1   = Val ( StringField ( Format, 1, "." ) )
            len2   = Val ( StringField ( Format, 2, "." ) )
            is_op  = #True
        EndSelect
       
        Select type
          Case 98  : help = Str  ( PeekB ( *value ) )       ; "b"
          Case 119 : help = Str  ( PeekW ( *value ) )       ; "w"
          Case 108 : help = Str  ( PeekL ( *value ) )       ; "l"
          Case 113 : help = StrQ ( PeekQ ( *value ) )       ; "q"
          Case 102 : help = StrF ( PeekF ( *value ), len2 ) ; "f"
          Case 100 : help = StrD ( PeekD ( *value ), len2 ) ; "d"
          Case 115 : help =        PeekS ( *value )         ; "s"
          Case 37  : help = "%" : result = Left ( result, pos1 - 1 ) + Mid ( result, pos2, Len(result)) ; "%"
          Case 43, 45, 46, 48 To 57 : pos2 + 1; "-","+",".","0","1","2","3","4","5","6","7","8","9"
          Default : exit = #True
        EndSelect
       
        If is_op = #True
          __Format__( help, len1 )
          result = Left ( result, pos1 - 1 ) + help + Mid ( result, pos2 + 1, Len(result))
          zeiger + 4
          exit = #True
        EndIf
       
      Until exit
      pos1 + Len ( help )
    Else
      Break
    EndIf
  ForEver
 
  ProcedureReturn result
 
EndProcedure

; ***************************************************************************************

; Test

name.s = "Michael"
alter.l = 99
Debug Format("Mein Name ist %20s und ich bin %l Jahre alt", @name, @alter)
Debug Format("Mein Name ist %-20s und ich bin %l Jahre alt", @name, @alter)

wert.f = 20.55
wert2.d = -12.12
Debug Format("Wert 1 = %8.2f%%, Wert 2 = %12.4d", @wert, @wert2)

tabelle.s = "Adressen"
plz = 20444

Debug format("Select * From %s Where Plz = %l", @tabelle, @plz)

MessageRequester("", Format("Mein Name ist %20s \n\r und \t ich bin \\%l Jahre alt", @name, @alter))

_________________
My Projects ThreadToGUI / OOP-BaseClass / OOP-BaseClassDispatch / EventDesigner V3
PB v3.30 / v5.70 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu May 01, 2008 6:12 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
Location: Berlin, Germany
Very useful, thank you!

A small improvement of readability:
Instead of
Code:
Case 98, 119, 108, 113, 102, 100, 115 ; "b", "w", "l", "q", "f", "d", "s"
it can be:
Code:
Case 'b', 'w', 'l', 'q', 'f', 'd', 's'

And a few lines below, it can be
Code:
Case 'b' : help = Str  ( PeekB ( *value ) )
Case 'w' : help = Str  ( PeekW ( *value ) )
; etc.

Thanks again.

Little John

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu May 01, 2008 8:26 pm 
Offline
User
User

Joined: Sun Oct 02, 2005 8:55 am
Posts: 60
Location: Czech Republic
@Little John,

if you compare characters is faster when you compare them as numbers

Code:
a.s = "b"

Select a
  Case "a"
  Case "b"
EndSelect


Code:
; a.s = "b"
  MOV    edx,_S1
  LEA    ecx,[v_a]
  CALL   SYS_FastAllocateStringFree
;
; Select a
  PUSH   dword [v_a]
; Case "a"
  MOV    edx,_S2
  MOV    ecx,[esp]
  CALL  _SYS_StringEqual <------ calling PB function StringEqual
  JE    _Case1
; Case "b"
  JMP   _EndSelect1
_Case1:
  MOV    edx,_S1
  MOV    ecx,[esp]
  CALL  _SYS_StringEqual
  JE    _Case2
; EndSelect
_Case2:
_EndSelect1:
  POP    eax




Code:
d.l = 100

Select d
  Case 65
  Case 100
EndSelect


Code:
; d.l = 100
  MOV    dword [v_d],100
;
; Select d
  PUSH   dword [v_d]
; Case 65
  MOV    ebx,65
  CMP    ebx,[esp]     <-------- asm instruction compare is faster
  JNE   _Case3
; Case 100
  JMP   _EndSelect2
_Case3:
  MOV    ebx,100
  CMP    ebx,[esp]
  JNE   _Case4
; EndSelect
_Case4:
_EndSelect2:
  POP    eax


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu May 01, 2008 8:59 pm 
Offline
Always Here
Always Here

Joined: Mon Sep 22, 2003 6:45 pm
Posts: 7439
Location: Norway
peterb: 'a' is a number. You are confusing 'a' with "a".


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri May 02, 2008 1:18 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 07, 2007 3:25 pm
Posts: 3715
Location: Berlin, Germany
2peterb:

Trond already wrote the answer. Please note that I did not write
Code:
Case "b", "w", "l", "q", "f", "d", "s"
This would not work anyway, since the regarding variable type is a Long, not a String.
My suggestion results in correct code. :)

Regards, Little John

_________________
Please excuse my flawed English. My native language is PureBasic.
Search
RSBasic's backups


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri May 02, 2008 2:44 pm 
Offline
User
User

Joined: Sun Oct 02, 2005 8:55 am
Posts: 60
Location: Czech Republic
@Little John, @Trond,

my mistake :wink:

nobody's perfect :D


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Jul 17, 2008 6:21 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jun 28, 2003 12:01 am
Posts: 490
Code snippet from above:
Code:
...

  result = ReplaceString(result, "\n", #CR$)
  result = ReplaceString(result, "\r", #LF$)
  result = ReplaceString(result, "\t", #TAB$)
  result = ReplaceString(result, "\\", "\")

...


This code can produce wrong results, if the string contains "\\n"

cu, helpy

_________________
Windows 10 / Windows 7
PB Last Final / Last Beta Testing


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri Jul 18, 2008 2:21 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Apr 25, 2003 11:08 pm
Posts: 443
You can replace those lines with:
Code:
result = ReplaceString(result, "\\", Chr(255))
result = ReplaceString(result, "\n", #CR$)
result = ReplaceString(result, "\r", #LF$)
result = ReplaceString(result, "\t", #TAB$)
result = ReplaceString(result, Chr(255), "\")

and it should work.

Regards,
Eric


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Fri Jul 18, 2008 2:33 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Jun 28, 2003 12:01 am
Posts: 490
YES! That is one alternative!

_________________
Windows 10 / Windows 7
PB Last Final / Last Beta Testing


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 55 posts ]  Go to page 1, 2, 3, 4  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 10 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye