Delphi-Projects

1
unit Russian;
2

3
interface
4

5
function RNeedDosToWin(const S: string): Boolean;
6
function RWin(const S: string): string;
7
function RDos(const S: string): string;
8
procedure RDosToWin(var S: string);
9
procedure RWinToDos(var S: string);
10

11
function RUpper(const S: string): string;
12
function RLower(const S: string): string;
13
procedure RUpper1st(var S: string);
14

15
function RStrToCurr(const S: string): Currency;
16
function RStrToCurrStr(const S: string): string;
17
function RStrToInt(const S: string): Integer;
18
function RStrToDate(const S: string): TDateTime;
19
function RStrToDateStr(const S: string): string;
20

21
function RCurrToStr(const V: Currency; const Delim: string = '.'): string;
22
function RDateToStr(const D: TDateTime): string; overload;
23
function RDateToStr(const S: string): string; overload;
24
function RDateToS(const D: TDateTime): string; overload;
25
function RDateToS(const S: string): string; overload;
26

27
function REndStr(N: Integer; const S1, S2, S: string): string;
28

29
implementation
30

31
uses
32
  SysUtils;
33

34
function RNeedDosToWin(const S: string): Boolean;
35
var
36
  B: Byte;
37
  I, IWin, IDos: Integer;
38
begin
39
  IWin := 0;
40
  IDos := 0;
41
  for I := 1 to Length(S) do
42
  begin
43
    B := Byte(S[I]);
44
    if B > 127 then
45
      if B < 176 then //DOS А128..Яа..п175
46
        Inc(IDos)
47
      else if B > 191 then //WIN А192..Я223
48
        if (B < 224) or (B > 239) then //WIN р240..я255
49
          Inc(IWin);
50
      //common DOS р224..я239 & WIN а224..п239 ignored
51
  end;
52
  Result := IDos > IWin;
53
end;
54

55
function RWin(const S: string): string;
56
begin
57
  Result := S;
58
  RDosToWin(Result);
59
end;
60

61
function RDos(const S: string): string;
62
begin
63
  Result := S;
64
  RWinToDos(Result);
65
end;
66

67
procedure RDosToWin(var S: string);
68
var
69
  B: Byte;
70
  I: Integer;
71
begin
72
  for I := 1 to Length(S) do
73
  begin
74
    B := Byte(S[I]);
75
    if B > 127 then
76
      if B < 176 then //А128..Яа..п175
77
        Inc(S[I], 64)
78
      else if B > 223 then //р224..я239
79
      begin
80
        if B < 240 then
81
          Inc(S[I], 16)
82
        else if B = 240 then //Ё240
83
          S[I] := #168 //'Е'
84
        else if B = 241 then //ё241
85
          S[I] := #184 //'е'
86
      end
87
      else if B in [193, 194, 196] then
88
        S[I] := #45 //'-'
89
      else if B in [179, 180, 195, 197] then
90
        S[I] := #124 //'|'
91
      else if B in [191, 192, 217, 218] then
92
        S[I] := #43; //'+'
93
  end;
94
end;
95

96
procedure RWinToDos(var S: string);
97
var
98
  B: Byte;
99
  I: Integer;
100
begin
101
  for I := 1 to Length(S) do
102
  begin
103
    B := Byte(S[I]);
104
    if B > 127 then
105
      if B > 239 then //р240..я255
106
        Dec(S[I], 16)
107
      else if B > 191 then //А191..Яа..п239
108
        Dec(S[I], 64)
109
      else if B = 168 then //Ё240
110
        S[I] := #133 //Е133
111
      else if B = 184 then //ё241
112
        S[I] := #165 //ё165
113
      else if B = 185 then //No
114
        S[I] := #78 //N
115
      else if B in [150, 151] then
116
        S[I] := #45; //--
117
  end;
118
end;
119

120
function RUpper(const S: string): string;
121
var
122
  I: Integer;
123
begin
124
  Result := S;
125
  for I := 1 to Length(S) do
126
    if S[I] >= #224 then
127
      Dec(Result[I], 32);
128
end;
129

130
function RLower(const S: string): string;
131
var
132
  I: Integer;
133
begin
134
  Result := S;
135
  for I := 1 to Length(S) do
136
    if (S[I] >= #192) and (S[I] <= #223) then
137
      Inc(Result[I], 32);
138
end;
139

140
procedure RUpper1st(var S: string);
141
begin
142
  if S[1] >= #224 then
143
    Dec(S[1], 32);
144
end;
145

146
{Читает всю строку с цифрами и возвращает денежное значение,
147
независимо от наличия пробелов и букв в этой строке,
148
но дробная часть отделяется после *последней* точки,
149
запятой, знака равенства или минуса...}
150
function RStrToCurr(const S: string): Currency;
151
const
152
  ValidChars = '1234567890.,-=';
153
var
154
  I, C, N, P: Integer;
155
begin
156
  Result := 0;
157
  N := 0;
158
  P := 0;
159
  for I := 1 to Length(S) do
160
  begin
161
    C := Pos(S[I], ValidChars);
162
    if C > 10 then
163
      P := N
164
    else if C = 10 then begin
165
      Result := Result * 10;
166
      Inc(N);
167
    end
168
    else if C > 0 then begin
169
      Result := Result * 10 + C;
170
      Inc(N);
171
    end;
172
  end;
173
  if P > 0 then
174
    while N > P do
175
    begin
176
      Result := Result / 10;
177
      Dec(N);
178
    end;
179
  if S[1] = '-' then Result := -Result;
180
end;
181

182
function RStrToInt(const S: string): Integer;
183
const
184
  ValidChars = '1234567890';
185
var
186
  I, C: Integer;
187
begin
188
  Result := 0;
189
  if S = '' then
190
    Exit;
191
  for I := 1 to Length(S) do
192
  begin
193
    C := Pos(S[I], ValidChars);
194
    if C = 10 then
195
      Result := Result * 10
196
    else if C > 0 then
197
      Result := Result * 10 + C;
198
  end;
199
  if S[1] = '-' then Result := -Result;
200
end;
201

202
{Читает дату почти в любом возможном числовом написании}
203
function RStrToDate(const S: string): TDateTime;
204
const
205
  ValidChars = '1234567890./-';
206
var
207
  I, P, C: Integer;
208
  SS: array[0..2] of string;
209
  DD, MM, YY: Word;
210
begin
211
  P := 0;
212
  SS[0] := '';
213
  SS[1] := '';
214
  SS[2] := '';
215
  for I := 1 to Length(S) do
216
  begin
217
    C := Pos(S[I], ValidChars);
218
    if C > 10 then
219
      Inc(P)
220
    else if C > 0 then
221
      SS[P] := SS[P] + S[I];
222
  end;
223

224
  DecodeDate(Date, YY, MM, DD); //this year by default
225
  if Length(SS[0]) = 8 then //YYYYMMDD
226
  begin
227
    I := StrToInt(SS[0]);
228
    DD := I mod 100;
229
    MM := I div 100 mod 100;
230
    YY := I div 10000;
231
  end
232
  else if Length(SS[0]) = 4 then begin //YYYY-MM-DD
233
    DD := StrToInt(SS[2]);
234
    MM := StrToInt(SS[1]);
235
    YY := StrToInt(SS[0]);
236
  end
237
  else if Length(SS[2]) > 0 then begin //DD.MM.[[YY]YY]
238
    DD := StrToInt(SS[0]);
239
    MM := StrToInt(SS[1]);
240
    if Length(SS[2]) = 4 then
241
      YY := StrToInt(SS[2])
242
    else if Length(SS[2]) = 2 then
243
    begin
244
      I := StrToInt(SS[2]);
245
      YY := YY div 100 * 100 + I;
246
      if I < TwoDigitYearCenturyWindow then
247
        Dec(YY, 100);
248
    end;
249
  end;
250
  Result := EncodeDate(YY, MM, DD);
251
end;
252

253
function RStrToDateStr(const S: string): string;
254
begin
255
  Result := DateToStr(RStrToDate(S));
256
end;
257

258
function RStrToCurrStr(const S: string): string;
259
begin
260
  Result := Format('%.2n', [RStrToCurr(S)]);
261
end;
262

263
function RCurrToStr(const V: Currency; const Delim: string = '.'): string;
264
begin
265
  Result := Format('%.2f', [V]);
266
  Result[Length(Result)-2] := Delim[1];
267
end;
268

269
function RDateToStr(const D: TDateTime): string;
270
begin
271
  Result := FormatDateTime('dd.mm.yyyy', D);
272
end;
273

274
function RDateToStr(const S: string): string;
275
begin
276
  Result := FormatDateTime('dd.mm.yyyy', RStrToDate(S));
277
end;
278

279
function RDateToS(const D: TDateTime): string;
280
begin
281
  Result := FormatDateTime('yyyymmdd', D);
282
end;
283

284
function RDateToS(const S: string): string;
285
begin
286
  Result := FormatDateTime('yyyymmdd', RStrToDate(S));
287
end;
288

289
function REndStr(N: Integer; const S1, S2, S: string): string;
290
begin
291
  if N > 100 then
292
    N := N mod 100;
293
  if N > 19 then
294
    N := N mod 10;
295
  case N of
296
    1:    Result := S1;
297
    2..4: Result := S2;
298
  else
299
    Result := S;
300
  end;
301
end;
302

303
end.
304