← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mricron/utopic

« back to all changes in this revision

Viewing changes to fpmath/ustrings.pas

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2010-07-29 22:07:43 UTC
  • Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
Import upstream version 0.20100725.1~dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpmath/ustrings.pas
 
1
{ ******************************************************************
 
2
                        Pascal string routines
 
3
  ****************************************************************** }
 
4
 
 
5
unit ustrings;
 
6
 
 
7
interface
 
8
 
 
9
uses
 
10
  utypes;
 
11
 
 
12
function LTrim(S : String) : String;
 
13
{ ------------------------------------------------------------------
 
14
  Removes leading blanks
 
15
  ------------------------------------------------------------------ }
 
16
 
 
17
function RTrim(S : String) : String;
 
18
{ ------------------------------------------------------------------
 
19
  Removes trailing blanks
 
20
  ------------------------------------------------------------------ }
 
21
 
 
22
function Trim(S : String) : String;
 
23
{ ------------------------------------------------------------------
 
24
  Removes leading and trailing blanks
 
25
  ------------------------------------------------------------------ }
 
26
 
 
27
function StrChar(N : Byte; C : Char) : String;
 
28
{ ------------------------------------------------------------------
 
29
  Returns a string made of character C repeated N times
 
30
  ------------------------------------------------------------------ }
 
31
 
 
32
function RFill(S : String; L : Byte) : String;
 
33
{ ------------------------------------------------------------------
 
34
  Completes string S with trailing blanks for a total length L
 
35
  ------------------------------------------------------------------ }
 
36
 
 
37
function LFill(S : String; L : Byte) : String;
 
38
{ ------------------------------------------------------------------
 
39
  Completes string S with leading blanks for a total length L
 
40
  ------------------------------------------------------------------ }
 
41
 
 
42
function CFill(S : String; L : Byte) : String;
 
43
{ ------------------------------------------------------------------
 
44
  Completes string S with leading blanks
 
45
  to center the string on a total length L
 
46
  ------------------------------------------------------------------ }
 
47
 
 
48
function Replace(S : String; C1, C2 : Char) : String;
 
49
{ ------------------------------------------------------------------
 
50
  Replaces in string S all the occurences
 
51
  of character C1 by character C2
 
52
  ------------------------------------------------------------------ }
 
53
 
 
54
function Extract(S : String; var Index : Byte; Delim : Char) : String;
 
55
{ ------------------------------------------------------------------
 
56
  Extracts a field from a string. Index is the position of the first
 
57
  character of the field. Delim is the character used to separate
 
58
  fields (e.g. blank, comma or tabulation). Blanks immediately
 
59
  following Delim are ignored. Index is updated to the position of
 
60
  the next field.
 
61
  ------------------------------------------------------------------ }
 
62
 
 
63
procedure Parse(S : String; Delim : Char; Field : PStrVector; var N : Byte);
 
64
{ ------------------------------------------------------------------
 
65
  Parses a string into its constitutive fields. Delim is the field
 
66
  separator. The number of fields is returned in N. The fields are
 
67
  returned in Field^[0]..Field^[N - 1]. Field must be dimensioned in
 
68
  the calling program.
 
69
  ------------------------------------------------------------------ }
 
70
 
 
71
procedure SetFormat(NumLength, MaxDec  : Integer;
 
72
                    FloatPoint, NSZero : Boolean);
 
73
{ ------------------------------------------------------------------
 
74
  Sets the numeric format
 
75
 
 
76
    NumLength  = Length of numeric field
 
77
    MaxDec     = Max. number of decimal places
 
78
    FloatPoint = True for floating point notation
 
79
    NSZero     = True to write non significant zero's
 
80
  ------------------------------------------------------------------ }
 
81
 
 
82
function FloatStr(X : Float) : String;
 
83
{ ------------------------------------------------------------------
 
84
  Converts a real to a string according to the numeric format
 
85
  ------------------------------------------------------------------ }
 
86
 
 
87
function IntStr(N : LongInt) : String;
 
88
{ ------------------------------------------------------------------
 
89
  Converts an integer to a string
 
90
  ------------------------------------------------------------------ }
 
91
 
 
92
function CompStr(Z : Complex) : String;
 
93
{ ------------------------------------------------------------------
 
94
  Converts a complex number to a string
 
95
  ------------------------------------------------------------------ }
 
96
 
 
97
implementation
 
98
 
 
99
const
 
100
  gNumLength  : Integer = 10;
 
101
  gMaxDec     : Integer =  4;
 
102
  gFloatPoint : Boolean = False;
 
103
  gNSZero     : Boolean = False;
 
104
 
 
105
  function LTrim(S : String) : String;
 
106
  begin
 
107
    if S <> '' then
 
108
      repeat
 
109
        if S[1] = ' ' then Delete(S, 1, 1);
 
110
      until S[1] <> ' ';
 
111
    LTrim := S;
 
112
  end;
 
113
 
 
114
  function RTrim(S : String) : String;
 
115
  var
 
116
    L1 : Byte;
 
117
  begin
 
118
    if S <> '' then
 
119
      repeat
 
120
        L1 := Length(S);
 
121
        if S[L1] = ' ' then Delete(S, L1, 1);
 
122
      until S[L1] <> ' ';
 
123
    RTrim := S;
 
124
  end;
 
125
 
 
126
  function Trim(S : String) : String;
 
127
  begin
 
128
    Trim := LTrim(RTrim(S));
 
129
  end;
 
130
 
 
131
  function StrChar(N : Byte; C : Char) : String;
 
132
  var
 
133
    I : Byte;
 
134
    S : String;
 
135
  begin
 
136
    S := '';
 
137
    for I := 1 to N do
 
138
      S := S + C;
 
139
    StrChar := S;
 
140
  end;
 
141
 
 
142
  function RFill(S : String; L : Byte) : String;
 
143
  var
 
144
    L1 : Byte;
 
145
  begin
 
146
    L1 := Length(S);
 
147
    if L1 >= L then
 
148
      RFill := S
 
149
    else
 
150
      RFill := S + StrChar(L - L1, ' ');
 
151
  end;
 
152
 
 
153
  function LFill(S : String; L : Byte) : String;
 
154
  var
 
155
    L1 : Byte;
 
156
  begin
 
157
    L1 := Length(S);
 
158
    if L1 >= L then
 
159
      LFill := S
 
160
    else
 
161
      LFill := StrChar(L - L1, ' ') + S;
 
162
  end;
 
163
 
 
164
  function CFill(S : String; L : Byte) : String;
 
165
  var
 
166
    L1 : Byte;
 
167
  begin
 
168
    L1 := Length(S);
 
169
    if L1 >= L then
 
170
      CFill := S
 
171
    else
 
172
      CFill := StrChar((L - L1) div 2, ' ') + S;
 
173
  end;
 
174
 
 
175
  function Replace(S : String; C1, C2 : Char) : String;
 
176
  var
 
177
    S1 : String;
 
178
    K : Byte;
 
179
  begin
 
180
    S1 := S;
 
181
    K := Pos(C1, S1);
 
182
    while K > 0 do
 
183
      begin
 
184
        S1[K] := C2;
 
185
        K := Pos(C1, S1);
 
186
      end;
 
187
    Replace := S1;
 
188
  end;
 
189
 
 
190
  function Extract(S : String; var Index : Byte; Delim : Char) : String;
 
191
  var
 
192
    I, L : Byte;
 
193
  begin
 
194
    I := Index;
 
195
    L := Length(S);
 
196
 
 
197
    { Search for Delim }
 
198
    while (I <= L) and (S[I] <> Delim) do
 
199
      Inc(I);
 
200
 
 
201
    { Extract field }
 
202
    if I = Index then
 
203
      Extract := ''
 
204
    else
 
205
      Extract := Copy(S, Index, I - Index);
 
206
 
 
207
    { Skip blanks after Delim }
 
208
    repeat
 
209
      Inc(I);
 
210
    until (I > L) or (S[I] <> ' ');
 
211
 
 
212
    { Update Index }
 
213
    Index := I;
 
214
  end;
 
215
 
 
216
  procedure Parse(S : String; Delim : Char; Field : PStrVector; var N : Byte);
 
217
  var
 
218
    I, Index, L : Byte;
 
219
  begin
 
220
    I := 0;
 
221
    Index := 1;
 
222
    L := Length(S);
 
223
    repeat
 
224
      Field^[I] := Extract(S, Index, Delim);
 
225
      Inc(I);
 
226
    until Index > L;
 
227
    N := I;
 
228
  end;
 
229
 
 
230
  procedure SetFormat(NumLength, MaxDec  : Integer;
 
231
                      FloatPoint, NSZero : Boolean);
 
232
  begin
 
233
    if (NumLength >= 1) and (NumLength <= 80) then gNumLength := NumLength;
 
234
    if (MaxDec    >= 0) and (MaxDec    <= 20) then gMaxDec    := MaxDec;
 
235
 
 
236
    gFloatPoint := FloatPoint;
 
237
    gNSZero     := NSZero;
 
238
  end;
 
239
 
 
240
  function RemZero(S : String) : String;
 
241
  var
 
242
    I      : Integer;
 
243
    S1, S2 : String;
 
244
    C      : Char;
 
245
  begin
 
246
    I := Pos('.', S);
 
247
 
 
248
    if I = 0 then
 
249
      begin
 
250
        RemZero := S;
 
251
        Exit
 
252
      end;
 
253
 
 
254
    I := Pos('E', S);
 
255
    if I = 0 then I := Pos('e', S);
 
256
 
 
257
    if I > 0 then
 
258
      begin
 
259
        S1 := Copy(S, 1, I - 1);
 
260
        S2 := Copy(S, I, Length(S) - I + 1)
 
261
      end
 
262
    else
 
263
      begin
 
264
        S1 := S;
 
265
        S2 := ''
 
266
      end;
 
267
 
 
268
    repeat
 
269
      I := Length(S1);
 
270
      C := S1[I];
 
271
      if (C = '0') or (C = '.') then S1 := Copy(S1, 1, I - 1)
 
272
    until C <> '0';
 
273
 
 
274
    RemZero := S1 + S2
 
275
  end;
 
276
 
 
277
  function FloatStr(X : Float) : String;
 
278
  var
 
279
    S : String;
 
280
  begin
 
281
    if gFloatPoint then
 
282
      begin
 
283
        Str(X:Pred(gNumLength), S);
 
284
        S := ' ' + S;
 
285
      end
 
286
    else
 
287
      Str(X:gNumLength:gMaxDec, S);
 
288
 
 
289
    if not gNSZero then
 
290
      S := RemZero(S);
 
291
 
 
292
    FloatStr := S;
 
293
  end;
 
294
 
 
295
  function IntStr(N : LongInt) : String;
 
296
  var
 
297
    S : String;
 
298
  begin
 
299
    Str(N:(gNumLength - gMaxDec - 1), S);
 
300
    IntStr := S;
 
301
  end;
 
302
 
 
303
  function CompStr(Z : Complex) : String;
 
304
  var
 
305
    S : String;
 
306
  begin
 
307
    if Z.Y >= 0.0 then S := ' + ' else S := ' - ';
 
308
    CompStr := FloatStr(Z.X) + S + FloatStr(Abs(Z.Y)) + ' * i';
 
309
  end;
 
310
 
 
311
end.
 
312