1 #Region "Microsoft.VisualBasic::d990fcf772cbcacd6833d5dd54414fcf, Microsoft.VisualBasic.Core\Language\Language\C\CFormatProvider.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module CLangStringFormatProvider
35     
36     '         FunctionFormatHex, FormatNumber, FormatOct, IsPositive, ReplaceMetaChars
37     '                   ReplaceMetaCharsMatch, sprintf, ToInteger, ToUnsigned, UnboxToLong
38     
39     
40     ' /********************************************************************************/
41
42 #End Region
43
44 #Region "Imports"
45 Imports System.Math
46 Imports System.Runtime.CompilerServices
47 Imports System.Text
48 Imports System.Text.RegularExpressions
49 Imports sys = System.Math
50 #End Region
51
52 Namespace Language.C
53
54     ''' <summary>
55     ''' Provides C like format print
56     ''' </summary>
57     ''' <remarks>https://github.com/mlnlover11/SharpLua</remarks>
58     Public Module CLangStringFormatProvider
59 #Region "Public Methods"
60
61 #Region "IsPositive"
62         ''' <summary>
63         ''' Determines whether the specified value is positive.
64         ''' </summary>
65         ''' <param name="Value">The value.</param>
66         ''' <param name="ZeroIsPositive">if set to true treats 0 as positive.</param>
67         ''' <returns>
68         ''' true if the specified value is positive; otherwise, false.
69         ''' </returns>
70         Public Function IsPositive(Value As ObjectOptional ZeroIsPositive As Boolean = TrueAs Boolean
71             Select Case Type.GetTypeCode(Value.[GetType]())
72                 Case TypeCode.[SByte]
73                     Return (If(ZeroIsPositive, CSByte(Value) >= 0, CSByte(Value) > 0))
74                 Case TypeCode.Int16
75                     Return (If(ZeroIsPositive, CShort(Value) >= 0, CShort(Value) > 0))
76                 Case TypeCode.Int32
77                     Return (If(ZeroIsPositive, CInt(Value) >= 0, CInt(Value) > 0))
78                 Case TypeCode.Int64
79                     Return (If(ZeroIsPositive, CLng(Value) >= 0, CLng(Value) > 0))
80                 Case TypeCode.[Single]
81                     Return (If(ZeroIsPositive, CSng(Value) >= 0, CSng(Value) > 0))
82                 Case TypeCode.[Double]
83                     Return (If(ZeroIsPositive, CDbl(Value) >= 0, CDbl(Value) > 0))
84                 Case TypeCode.[Decimal]
85                     Return (If(ZeroIsPositive, CDec(Value) >= 0, CDec(Value) > 0))
86                 Case TypeCode.[Byte]
87                     Return (If(ZeroIsPositive, TrueCByte(Value) > 0))
88                 Case TypeCode.UInt16
89                     Return (If(ZeroIsPositive, TrueCUShort(Value) > 0))
90                 Case TypeCode.UInt32
91                     Return (If(ZeroIsPositive, TrueCUInt(Value) > 0))
92                 Case TypeCode.UInt64
93                     Return (If(ZeroIsPositive, TrueCULng(Value) > 0))
94                 Case TypeCode.[Char]
95                     Return (If(ZeroIsPositive, TrueCChar(Value) <> ControlChars.NullChar))
96                 Case Else
97                     Return False
98             End Select
99         End Function
100 #End Region
101
102 #Region "ToUnsigned"
103         ''' <summary>
104         ''' Converts the specified values boxed type to its correpsonding unsigned
105         ''' type.
106         ''' </summary>
107         ''' <param name="Value">The value.</param>
108         ''' <returns>A boxed numeric object whos type is unsigned.</returns>
109         Public Function ToUnsigned(Value As ObjectAs Object
110             Select Case Type.GetTypeCode(Value.[GetType]())
111                 Case TypeCode.[SByte]
112                     Return CByte(CSByte(Value))
113                 Case TypeCode.Int16
114                     Return CUShort(CShort(Value))
115                 Case TypeCode.Int32
116                     Return CUInt(CInt(Value))
117                 Case TypeCode.Int64
118                     Return CULng(CLng(Value))
119
120                 Case TypeCode.[Byte]
121                     Return Value
122                 Case TypeCode.UInt16
123                     Return Value
124                 Case TypeCode.UInt32
125                     Return Value
126                 Case TypeCode.UInt64
127                     Return Value
128
129                 Case TypeCode.[Single]
130                     Return CType(Truncate(CSng(Value)), UInt32)
131                 Case TypeCode.[Double]
132                     Return CULng(Truncate(CDbl(Value)))
133                 Case TypeCode.[Decimal]
134                     Return CULng(Truncate(CDec(Value)))
135                 Case Else
136
137                     Return Nothing
138             End Select
139         End Function
140 #End Region
141
142 #Region "ToInteger"
143         ''' <summary>
144         ''' Converts the specified values boxed type to its correpsonding integer
145         ''' type.
146         ''' </summary>
147         ''' <param name="Value">The value.</param>
148         ''' <returns>A boxed numeric object whos type is an integer type.</returns>
149         Public Function ToInteger(Value As Object, Round As BooleanAs Object
150             Select Case Type.GetTypeCode(Value.[GetType]())
151                 Case TypeCode.[SByte]
152                     Return Value
153                 Case TypeCode.Int16
154                     Return Value
155                 Case TypeCode.Int32
156                     Return Value
157                 Case TypeCode.Int64
158                     Return Value
159
160                 Case TypeCode.[Byte]
161                     Return Value
162                 Case TypeCode.UInt16
163                     Return Value
164                 Case TypeCode.UInt32
165                     Return Value
166                 Case TypeCode.UInt64
167                     Return Value
168
169                 Case TypeCode.[Single]
170                     Return (If(Round, CInt(Truncate(sys.Round(CSng(Value)))), CInt(Truncate(CSng(Value)))))
171                 Case TypeCode.[Double]
172                     Return (If(Round, CLng(Truncate(sys.Round(CDbl(Value)))), CLng(Truncate(CDbl(Value)))))
173                 Case TypeCode.[Decimal]
174                     Return (If(Round, sys.Round(CDec(Value)), CDec(Value)))
175                 Case Else
176
177                     Return Nothing
178             End Select
179         End Function
180 #End Region
181
182 #Region "UnboxToLong"
183         Public Function UnboxToLong(Value As Object, Round As BooleanAs Long
184             Select Case Type.GetTypeCode(Value.[GetType]())
185                 Case TypeCode.[SByte]
186                     Return CLng(CSByte(Value))
187                 Case TypeCode.Int16
188                     Return CLng(CShort(Value))
189                 Case TypeCode.Int32
190                     Return CLng(CInt(Value))
191                 Case TypeCode.Int64
192                     Return CLng(Value)
193
194                 Case TypeCode.[Byte]
195                     Return CLng(CByte(Value))
196                 Case TypeCode.UInt16
197                     Return CLng(CUShort(Value))
198                 Case TypeCode.UInt32
199                     Return CLng(CUInt(Value))
200                 Case TypeCode.UInt64
201                     Return CLng(CULng(Value))
202
203                 Case TypeCode.[Single]
204                     Return (If(Round, CLng(Truncate(sys.Round(CSng(Value)))), CLng(Truncate(CSng(Value)))))
205                 Case TypeCode.[Double]
206                     Return (If(Round, CLng(Truncate(sys.Round(CDbl(Value)))), CLng(Truncate(CDbl(Value)))))
207                 Case TypeCode.[Decimal]
208                     Return (If(Round, CLng(Truncate(sys.Round(CDec(Value)))), CLng(Truncate(CDec(Value)))))
209                 Case Else
210
211                     Return 0
212             End Select
213         End Function
214 #End Region
215
216 #Region "ReplaceMetaChars"
217         ''' <summary>
218         ''' Replaces the string representations of meta chars with their corresponding
219         ''' character values..(替换掉转义字符)
220         ''' </summary>
221         ''' <param name="input">The input.</param>
222         ''' <returns>A string with all string meta chars are replaced</returns>
223         <Extension> Public Function ReplaceMetaChars(input As StringAs String
224             Return Regex.Replace(input, "(\\)(\d{3}|[^\d])?"New MatchEvaluator(AddressOf ReplaceMetaCharsMatch))
225         End Function
226
227         Private Function ReplaceMetaCharsMatch(m As Match) As String
228             ' convert octal quotes (like \040)
229             If m.Groups(2).Length = 3 Then
230                 Return Convert.ToChar(Convert.ToByte(m.Groups(2).Value, 8)).ToString()
231             Else
232                 ' convert all other special meta characters
233                 'TODO: \xhhh hex and possible dec !!
234                 Select Case m.Groups(2).Value
235                     Case "0"
236                         ' null
237                         Return vbNullChar
238                     Case "a"
239                         ' alert (beep)
240                         Return ChrW(7)
241                     Case "b"
242                         ' BS
243                         Return vbBack
244                     Case "f"
245                         ' FF
246                         Return vbFormFeed
247                     Case "v"
248                         ' vertical tab
249                         Return vbVerticalTab
250                     Case "r"
251                         ' CR
252                         Return vbCr
253                     Case "n"
254                         ' LF
255                         Return vbLf
256                     Case "t"
257                         ' Tab
258                         Return vbTab
259                     Case Else
260                         ' if neither an octal quote nor a special meta character
261                         ' so just remove the backslash
262                         Return m.Groups(2).Value
263                 End Select
264             End If
265         End Function
266 #End Region
267
268 #Region "fprintf"
269
270         ''' <summary>
271         ''' %[parameter][flags][width][.precision][length]type
272         ''' </summary>
273         Const Formats As String = "\%(\d*\$)?([\'\#\-\+ ]*)(\d*)(?:\.(\d+))?([hl])?([dioxXucsfeEgGpn%])"
274
275         ReadOnly r As New Regex(Formats)
276
277 #End Region
278 #Region "sprintf"
279
280         ''' <summary>
281         ''' Format string like C
282         ''' </summary>
283         ''' <param name="format"></param>
284         ''' <param name="parameters"></param>
285         ''' <returns></returns>
286         Public Function sprintf(format$, ParamArray parameters As Object()) As String
287             '#Region "Variables"
288             Dim f As New StringBuilder()
289             'Regex r = new Regex( @"\%(\d*\$)?([\'\#\-\+ ]*)(\d*)(?:\.(\d+))?([hl])?([dioxXucsfeEgGpn%])" );
290             '"%[parameter][flags][width][.precision][length]type"
291             Dim m As Match = Nothing
292             Dim w As String = String.Empty
293             Dim defaultParamIx As Integer = 0
294             Dim paramIx As Integer
295             Dim o As Object = Nothing
296
297             Dim flagLeft2Right As Boolean = False
298             Dim flagAlternate As Boolean = False
299             Dim flagPositiveSign As Boolean = False
300             Dim flagPositiveSpace As Boolean = False
301             Dim flagZeroPadding As Boolean = False
302             Dim flagGroupThousands As Boolean = False
303
304             Dim fieldLength As Integer = 0
305             Dim fieldPrecision As Integer = 0
306             Dim shortLongIndicator As Char = ControlChars.NullChar
307             Dim formatSpecifier As Char = ControlChars.NullChar
308             Dim paddingCharacter As Char = " "c
309             '#End Region
310
311             format = format.Replace("\\""\")
312             format = format.Replace("\n", vbLf)
313             format = format.Replace("\t", vbTab)
314
315             ' find all format parameters in format string
316             f.Append(format)
317             m = r.Match(f.ToString())
318             While m.Success
319                 '#Region "parameter index"
320                 paramIx = defaultParamIx
321                 If m.Groups(1) IsNot Nothing AndAlso m.Groups(1).Value.Length > 0 Then
322                     Dim val As String = m.Groups(1).Value.Substring(0, m.Groups(1).Value.Length - 1)
323                     paramIx = Convert.ToInt32(val) - 1
324                 End If
325
326
327                 '#End Region
328
329                 '#Region "format flags"
330                 ' extract format flags
331                 flagAlternate = False
332                 flagLeft2Right = False
333                 flagPositiveSign = False
334                 flagPositiveSpace = False
335                 flagZeroPadding = False
336                 flagGroupThousands = False
337                 If m.Groups(2) IsNot Nothing AndAlso m.Groups(2).Value.Length > 0 Then
338                     Dim flags As String = m.Groups(2).Value
339
340                     flagAlternate = (flags.IndexOf("#"c) >= 0)
341                     flagLeft2Right = (flags.IndexOf("-"c) >= 0)
342                     flagPositiveSign = (flags.IndexOf("+"c) >= 0)
343                     flagPositiveSpace = (flags.IndexOf(" "c) >= 0)
344                     flagGroupThousands = (flags.IndexOf("'"c) >= 0)
345
346                     ' positive + indicator overrides a
347                     ' positive space character
348                     If flagPositiveSign AndAlso flagPositiveSpace Then
349                         flagPositiveSpace = False
350                     End If
351                 End If
352                 '#End Region
353
354                 '#Region "field length"
355                 ' extract field length and
356                 ' pading character
357                 paddingCharacter = " "c
358                 fieldLength = Integer.MinValue
359                 If m.Groups(3) IsNot Nothing AndAlso m.Groups(3).Value.Length > 0 Then
360                     fieldLength = Convert.ToInt32(m.Groups(3).Value)
361                     flagZeroPadding = (m.Groups(3).Value(0) = "0"c)
362                 End If
363                 '#End Region
364
365                 If flagZeroPadding Then
366                     paddingCharacter = "0"c
367                 End If
368
369                 ' left2right allignment overrides zero padding
370                 If flagLeft2Right AndAlso flagZeroPadding Then
371                     flagZeroPadding = False
372                     paddingCharacter = " "c
373                 End If
374
375                 '#Region "field precision"
376                 ' extract field precision
377                 fieldPrecision = Integer.MinValue
378                 If m.Groups(4) IsNot Nothing AndAlso m.Groups(4).Value.Length > 0 Then
379                     fieldPrecision = Convert.ToInt32(m.Groups(4).Value)
380                 End If
381                 '#End Region
382
383                 '#Region "short / long indicator"
384                 ' extract short / long indicator
385                 shortLongIndicator = [Char].MinValue
386                 If m.Groups(5) IsNot Nothing AndAlso m.Groups(5).Value.Length > 0 Then
387                     shortLongIndicator = m.Groups(5).Value(0)
388                 End If
389                 '#End Region
390
391                 '#Region "format specifier"
392                 ' extract format
393                 formatSpecifier = [Char].MinValue
394                 If m.Groups(6) IsNot Nothing AndAlso m.Groups(6).Value.Length > 0 Then
395                     formatSpecifier = m.Groups(6).Value(0)
396                 End If
397                 '#End Region
398
399                 ' default precision is 6 digits if none is specified except
400                 If fieldPrecision = Integer.MinValue AndAlso formatSpecifier <> "s"AndAlso formatSpecifier <> "c"AndAlso [Char].ToUpper(formatSpecifier) <> "X"AndAlso formatSpecifier <> "o"Then
401                     fieldPrecision = 6
402                 End If
403
404                 '#Region "get next value parameter"
405                 ' get next value parameter and convert value parameter depending on short / long indicator
406                 If parameters Is Nothing OrElse paramIx >= parameters.Length Then
407                     o = Nothing
408                 Else
409                     o = parameters(paramIx)
410
411                     If shortLongIndicator = "h"Then
412                         If TypeOf o Is Integer Then
413                             o = CShort(CInt(o))
414                         ElseIf TypeOf o Is Long Then
415                             o = CShort(CLng(o))
416                         ElseIf TypeOf o Is UInteger Then
417                             o = CUShort(CUInt(o))
418                         ElseIf TypeOf o Is ULong Then
419                             o = CUShort(CULng(o))
420                         End If
421                     ElseIf shortLongIndicator = "l"Then
422                         If TypeOf o Is Short Then
423                             o = CLng(CShort(o))
424                         ElseIf TypeOf o Is Integer Then
425                             o = CLng(CInt(o))
426                         ElseIf TypeOf o Is UShort Then
427                             o = CULng(CUShort(o))
428                         ElseIf TypeOf o Is UInteger Then
429                             o = CULng(CUInt(o))
430                         End If
431                     End If
432                 End If
433                 '#End Region
434
435                 ' convert value parameters to a string depending on the formatSpecifier
436                 w = String.Empty
437                 Select Case formatSpecifier
438                     '#Region "% - character"
439                     Case "%"c
440                         ' % character
441                         w = "%"
442
443                     '#End Region
444                     '#Region "d - integer"
445                     Case "d"c, "i"c
446                         ' integer
447                         w = FormatNumber((If(flagGroupThousands, "n""d")), flagAlternate, fieldLength, Integer.MinValue, flagLeft2Right, flagPositiveSign,
448                             flagPositiveSpace, paddingCharacter, o)
449                         defaultParamIx += 1
450
451                         '#End Region
452                         '#Region "i - integer"
453                         '   Case "i"c
454                         ' integer
455                       '  GoTo case "d"C
456                     '#End Region
457                     '#Region "o - octal integer"
458                     Case "o"c
459                         ' octal integer - no leading zero
460                         w = FormatOct("o", flagAlternate, fieldLength, Integer.MinValue, flagLeft2Right, paddingCharacter,
461                             o)
462                         defaultParamIx += 1
463
464                     '#End Region
465                     '#Region "x - hex integer"
466                     Case "x"c
467                         ' hex integer - no leading zero
468                         w = FormatHex("x", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, paddingCharacter,
469                             o)
470                         defaultParamIx += 1
471
472                     '#End Region
473                     '#Region "X - hex integer"
474                     Case "X"c
475                         ' same as x but with capital hex characters
476                         w = FormatHex("X", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, paddingCharacter,
477                             o)
478                         defaultParamIx += 1
479
480                     '#End Region
481                     '#Region "u - unsigned integer"
482                     Case "u"c
483                         ' unsigned integer
484                         w = FormatNumber((If(flagGroupThousands, "n""d")), flagAlternate, fieldLength, Integer.MinValue, flagLeft2Right, False,
485                             False, paddingCharacter, ToUnsigned(o))
486                         defaultParamIx += 1
487
488                     '#End Region
489                     '#Region "c - character"
490                     Case "c"c
491                         ' character
492                         If IsNumericType(o) Then
493                             w = Convert.ToChar(o).ToString()
494                         ElseIf TypeOf o Is Char Then
495                             w = CChar(o).ToString()
496                         ElseIf TypeOf o Is String AndAlso DirectCast(o, String).Length > 0 Then
497                             w = DirectCast(o, String)(0).ToString()
498                         End If
499                         defaultParamIx += 1
500
501                     '#End Region
502                     '#Region "s - string"
503                     Case "s"c
504                         ' string
505                         Dim t As String = "{0" & (If(fieldLength <> Integer.MinValue, "," & (If(flagLeft2Right, "-"String.Empty)) & fieldLength.ToString(), String.Empty)) & ":s}"
506                         w = Scripting.ToString(o)
507                         If fieldPrecision >= 0 Then
508                             w = w.Substring(0, fieldPrecision)
509                         End If
510
511                         If fieldLength <> Integer.MinValue Then
512                             If flagLeft2Right Then
513                                 w = w.PadRight(fieldLength, paddingCharacter)
514                             Else
515                                 w = w.PadLeft(fieldLength, paddingCharacter)
516                             End If
517                         End If
518                         defaultParamIx += 1
519
520                     '#End Region
521                     '#Region "f - double number"
522                     Case "f"c
523                         ' double
524                         w = FormatNumber((If(flagGroupThousands, "n""f")), flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, flagPositiveSign,
525                             flagPositiveSpace, paddingCharacter, o)
526                         defaultParamIx += 1
527
528                     '#End Region
529                     '#Region "e - exponent number"
530                     Case "e"c
531                         ' double / exponent
532                         w = FormatNumber("e", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, flagPositiveSign,
533                             flagPositiveSpace, paddingCharacter, o)
534                         defaultParamIx += 1
535
536                     '#End Region
537                     '#Region "E - exponent number"
538                     Case "E"c
539                         ' double / exponent
540                         w = FormatNumber("E", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, flagPositiveSign,
541                             flagPositiveSpace, paddingCharacter, o)
542                         defaultParamIx += 1
543
544                     '#End Region
545                     '#Region "g - general number"
546                     Case "g"c
547                         ' double / exponent
548                         w = FormatNumber("g", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, flagPositiveSign,
549                             flagPositiveSpace, paddingCharacter, o)
550                         defaultParamIx += 1
551
552                     '#End Region
553                     '#Region "G - general number"
554                     Case "G"c
555                         ' double / exponent
556                         w = FormatNumber("G", flagAlternate, fieldLength, fieldPrecision, flagLeft2Right, flagPositiveSign,
557                             flagPositiveSpace, paddingCharacter, o)
558                         defaultParamIx += 1
559
560                     '#End Region
561                     '#Region "p - pointer"
562                     Case "p"c
563                         ' pointer
564                         If TypeOf o Is IntPtr Then
565
566 #If XBOX OrElse SILVERLIGHT Then
567
568 w = CType(o, IntPtr).ToString()
569     End If
570 #Else
571                             w = "0x" & CType(o, IntPtr).ToString("x")
572                         End If
573 #End If
574                         defaultParamIx += 1
575
576                     '#End Region
577                     '#Region "n - number of processed chars so far"
578                     Case "n"c
579                         ' number of characters so far
580                         w = FormatNumber("d", flagAlternate, fieldLength, Integer.MinValue, flagLeft2Right, flagPositiveSign,
581                             flagPositiveSpace, paddingCharacter, m.Index)
582
583                     Case Else
584                         '#End Region
585                         w = String.Empty
586                         defaultParamIx += 1
587
588                 End Select
589
590                 ' replace format parameter with parameter value
591                 ' and start searching for the next format parameter
592                 ' AFTER the position of the current inserted value
593                 ' to prohibit recursive matches if the value also
594                 ' includes a format specifier
595                 f.Remove(m.Index, m.Length)
596                 f.Insert(m.Index, w)
597                 m = r.Match(f.ToString(), startat:=m.Index + w?.Length)
598             End While
599
600             Call f.Replace("\""\")
601
602             Return f.ToString()
603         End Function
604 #End Region
605 #End Region
606
607 #Region "Private Methods"
608 #Region "FormatOCT"
609         Private Function FormatOct(NativeFormat As String, Alternate As Boolean, FieldLength As Integer, FieldPrecision As Integer, Left2Right As Boolean, Padding As Char,
610             Value As ObjectAs String
611             Dim w As String = String.Empty
612             Dim lengthFormat As String = "{0" & (If(FieldLength <> Integer.MinValue, "," & (If(Left2Right, "-"String.Empty)) & FieldLength.ToString(), String.Empty)) & "}"
613
614             If IsNumericType(Value) Then
615                 w = Convert.ToString(UnboxToLong(Value, True), 8)
616
617                 If Left2Right OrElse Padding = " "Then
618                     If Alternate AndAlso w <> "0" Then
619                         w = "0" & w
620                     End If
621                     w = String.Format(lengthFormat, w)
622                 Else
623                     If FieldLength <> Integer.MinValue Then
624                         w = w.PadLeft(FieldLength - (If(Alternate AndAlso w <> "0", 1, 0)), Padding)
625                     End If
626                     If Alternate AndAlso w <> "0" Then
627                         w = "0" & w
628                     End If
629                 End If
630             End If
631
632             Return w
633         End Function
634 #End Region
635 #Region "FormatHEX"
636         Private Function FormatHex(NativeFormat As String, Alternate As Boolean, FieldLength As Integer, FieldPrecision As Integer, Left2Right As Boolean, Padding As Char,
637             Value As ObjectAs String
638             Dim w As String = String.Empty
639             Dim lengthFormat As String = "{0" & (If(FieldLength <> Integer.MinValue, "," & (If(Left2Right, "-"String.Empty)) & FieldLength.ToString(), String.Empty)) & "}"
640             Dim numberFormat As String = "{0:" & NativeFormat & (If(FieldPrecision <> Integer.MinValue, FieldPrecision.ToString(), String.Empty)) & "}"
641
642             If IsNumericType(Value) Then
643                 w = String.Format(numberFormat, Value)
644
645                 If Left2Right OrElse Padding = " "Then
646                     If Alternate Then
647                         w = (If(NativeFormat = "x""0x""0X")) & w
648                     End If
649                     w = String.Format(lengthFormat, w)
650                 Else
651                     If FieldLength <> Integer.MinValue Then
652                         w = w.PadLeft(FieldLength - (If(Alternate, 2, 0)), Padding)
653                     End If
654                     If Alternate Then
655                         w = (If(NativeFormat = "x""0x""0X")) & w
656                     End If
657                 End If
658             End If
659
660             Return w
661         End Function
662 #End Region
663 #Region "FormatNumber"
664         Private Function FormatNumber(NativeFormat As String,
665                                   Alternate As Boolean,
666                                   FieldLength As Integer,
667                                   FieldPrecision As Integer,
668                                   Left2Right As Boolean,
669                                   PositiveSign As Boolean,
670                                   PositiveSpace As Boolean,
671                                   Padding As Char,
672                                   Value As ObjectAs String
673
674             Dim w As String = String.Empty
675             Dim lengthFormat As String = "{0" & (If(FieldLength <> Integer.MinValue, "," & (If(Left2Right, "-"String.Empty)) & FieldLength.ToString(), String.Empty)) & "}"
676             Dim numberFormat As String = "{0:" & NativeFormat & (If(FieldPrecision <> Integer.MinValue, FieldPrecision.ToString(), "0")) & "}"
677
678             If IsNumericType(Value) Then
679                 w = String.Format(numberFormat, Value)
680
681                 If Left2Right OrElse Padding = " "Then
682                     If IsPositive(Value, TrueThen
683                         w = (If(PositiveSign, "+", (If(PositiveSpace, " "String.Empty)))) & w
684                     End If
685                     w = String.Format(lengthFormat, w)
686                 Else
687                     If w.StartsWith("-"Then
688                         w = w.Substring(1)
689                     End If
690                     If FieldLength <> Integer.MinValue Then
691                         w = w.PadLeft(FieldLength - 1, Padding)
692                     End If
693                     If IsPositive(Value, TrueThen
694                         w = (If(PositiveSign, "+", (If(PositiveSpace, " "String.Empty)))) & w
695                     Else
696                         w = "-" & w
697                     End If
698                 End If
699             End If
700
701             Return w
702         End Function
703 #End Region
704 #End Region
705     End Module
706 End Namespace