e001f8567a3af1ad810da064330ec9cb595d0183
1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
25 GAME_VERSION
= '0.667';
31 UID_MAX_PLAYER
= $7FFF;
32 UID_MAX_MONSTER
= $FFFF;
35 TDirection
= (D_LEFT
, D_RIGHT
);
36 WArray
= array of Word;
37 DWArray
= array of DWORD
;
38 String20
= String[20];
40 function g_CreateUID(UIDType
: Byte): Word;
41 function g_GetUIDType(UID
: Word): Byte;
42 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
43 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
44 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
45 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean;
46 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean;
47 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
48 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
49 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean;
50 function g_CollideMonster(X
, Y
: Integer; Width
, Height
: Word): Boolean;
51 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
52 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
53 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
54 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
55 procedure IncMax(var A
: Integer; B
, Max
: Integer); overload
;
56 procedure IncMax(var A
: Single; B
, Max
: Single); overload
;
57 procedure IncMax(var A
: Integer; Max
: Integer); overload
;
58 procedure IncMax(var A
: Single; Max
: Single); overload
;
59 procedure IncMax(var A
: Word; B
, Max
: Word); overload
;
60 procedure IncMax(var A
: Word; Max
: Word); overload
;
61 procedure IncMax(var A
: SmallInt; B
, Max
: SmallInt); overload
;
62 procedure IncMax(var A
: SmallInt; Max
: SmallInt); overload
;
63 procedure DecMin(var A
: Integer; B
, Min
: Integer); overload
;
64 procedure DecMin(var A
: Single; B
, Min
: Single); overload
;
65 procedure DecMin(var A
: Integer; Min
: Integer); overload
;
66 procedure DecMin(var A
: Single; Min
: Single); overload
;
67 procedure DecMin(var A
: Word; B
, Min
: Word); overload
;
68 procedure DecMin(var A
: Word; Min
: Word); overload
;
69 procedure DecMin(var A
: Byte; B
, Min
: Byte); overload
;
70 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
71 function Sign(A
: Integer): ShortInt; overload
;
72 function Sign(A
: Single): ShortInt; overload
;
73 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
74 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt;
75 function GetAngle2(vx
, vy
: Integer): SmallInt;
76 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SArray
;
77 procedure Sort(var a
: SArray
);
78 function Sscanf(const s
: string; const fmt
: string;
79 const Pointers
: array of Pointer): Integer;
80 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
81 function InWArray(a
: Word; arr
: WArray
): Boolean;
82 function InSArray(a
: string; arr
: SArray
): Boolean;
83 function GetPos(UID
: Word; o
: PObj
): Boolean;
84 function parse(s
: string): SArray
;
85 function parse2(s
: string; delim
: Char): SArray
;
86 function g_GetFileTime(fileName
: String): Integer;
87 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
88 procedure SortSArray(var S
: SArray
);
89 function b_Text_Format(S
: string): string;
90 function b_Text_Unformat(S
: string): string;
95 Math
, g_map
, g_gfx
, g_player
, SysUtils
, MAPDEF
,
96 StrUtils
, e_graphics
, g_monsters
, g_items
;
98 function g_PatchLength(X1
, Y1
, X2
, Y2
: Integer): Word;
100 Result
:= Min(Round(Hypot(Abs(X2
-X1
), Abs(Y2
-Y1
))), 65535);
103 function g_CollideLevel(X
, Y
: Integer; Width
, Height
: Word): Boolean;
105 result
:= g_Map_CollidePanel(X
, Y
, Width
, Height
, (PANEL_WALL
or PANEL_CLOSEDOOR
or PANEL_OPENDOOR
), false);
116 for a := 0 to High(gWalls) do
117 if gWalls[a].Enabled and
118 not ( ((Y + Height <= gWalls[a].Y) or
119 (Y >= gWalls[a].Y + gWalls[a].Height)) or
120 ((X + Width <= gWalls[a].X) or
121 (X >= gWalls[a].X + gWalls[a].Width)) ) then
129 function g_CollidePlayer(X
, Y
: Integer; Width
, Height
: Word): Boolean;
135 if gPlayers
= nil then Exit
;
137 for a
:= 0 to High(gPlayers
) do
138 if (gPlayers
[a
] <> nil) and gPlayers
[a
].Live
then
139 if gPlayers
[a
].Collide(X
, Y
, Width
, Height
) then
146 function g_CollideMonster(X
, Y
: Integer; Width
, Height
: Word): Boolean;
148 result
:= g_Mons_AnyAt(X
, Y
, Width
, Height
);
151 function g_TraceVector(X1
, Y1
, X2
, Y2
: Integer): Boolean;
155 Xerr
, Yerr
, d
: LongWord;
161 Assert(gCollideMap
<> nil, 'g_TraceVector: gCollideMap = nil');
168 if dx
> 0 then incX
:= 1 else if dx
< 0 then incX
:= -1 else incX
:= 0;
169 if dy
> 0 then incY
:= 1 else if dy
< 0 then incY
:= -1 else incY
:= 0;
174 if dx
> dy
then d
:= dx
else d
:= dy
;
194 if (y
> gMapInfo
.Height
-1) or
195 (y
< 0) or (x
> gMapInfo
.Width
-1) or (x
< 0) then
197 if ByteBool(gCollideMap
[y
, x
] and MARK_BLOCKED
) then
204 function g_CreateUID(UIDType
: Byte): Word;
215 Result
:= UID_MAX_GAME
+$1+Random(UID_MAX_PLAYER
-UID_MAX_GAME
+$1);
218 if gPlayers
<> nil then
219 for i
:= 0 to High(gPlayers
) do
220 if gPlayers
[i
] <> nil then
221 if Result
= gPlayers
[i
].UID
then
234 result
:= UID_MAX_PLAYER
+$1+Random(UID_MAX_MONSTER
-UID_MAX_GAME
-UID_MAX_PLAYER
+$1);
235 if (g_Monsters_Get(result
) = nil) then break
;
241 function g_GetUIDType(UID
: Word): Byte;
243 if UID
<= UID_MAX_GAME
then
246 if UID
<= UID_MAX_PLAYER
then
249 Result
:= UID_MONSTER
;
252 function g_Collide(X1
, Y1
: Integer; Width1
, Height1
: Word;
253 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
255 Result
:= not ( ((Y1
+ Height1
<= Y2
) or
256 (Y2
+ Height2
<= Y1
)) or
257 ((X1
+ Width1
<= X2
) or
258 (X2
+ Width2
<= X1
)) );
261 function g_CollideAround(X1
, Y1
: Integer; Width1
, Height1
: Word;
262 X2
, Y2
: Integer; Width2
, Height2
: Word): Boolean;
264 Result
:= g_Collide(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
265 g_Collide(X1
+1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
266 g_Collide(X1
-1, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
267 g_Collide(X1
, Y1
+1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
) or
268 g_Collide(X1
, Y1
-1, Width1
, Height1
, X2
, Y2
, Width2
, Height2
);
271 function c(X1
, Y1
, Width1
, Height1
, X2
, Y2
, Width2
, Height2
: Integer): Boolean;
273 Result
:= not (((Y1
+ Height1
<= Y2
) or
274 (Y1
>= Y2
+ Height2
)) or
275 ((X1
+ Width1
<= X2
) or
276 (X1
>= X2
+ Width2
)));
279 function g_Collide2(X1
, Y1
, X2
, Y2
, X3
, Y3
, X4
, Y4
: Integer): Boolean;
281 //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4)));
282 Result
:= c(X1
, Y1
, X2
-X1
, Y2
-Y1
, X3
, Y3
, X4
-X3
, Y4
-Y3
);
285 function g_CollidePoint(X
, Y
, X2
, Y2
: Integer; Width
, Height
: Word): Boolean;
289 Result
:= (x
>= 0) and (x
<= Width
) and
290 (y
>= 0) and (y
<= Height
);
293 procedure IncMax(var A
: Integer; B
, Max
: Integer);
295 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
298 procedure IncMax(var A
: Single; B
, Max
: Single);
300 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
303 procedure DecMin(var A
: Integer; B
, Min
: Integer);
305 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
308 procedure DecMin(var A
: Word; B
, Min
: Word);
310 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
313 procedure DecMin(var A
: Single; B
, Min
: Single);
315 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
318 procedure IncMax(var A
: Integer; Max
: Integer);
320 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
323 procedure IncMax(var A
: Single; Max
: Single);
325 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
328 procedure IncMax(var A
: Word; B
, Max
: Word);
330 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
333 procedure IncMax(var A
: Word; Max
: Word);
335 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
338 procedure IncMax(var A
: SmallInt; B
, Max
: SmallInt);
340 if A
+B
> Max
then A
:= Max
else A
:= A
+B
;
343 procedure IncMax(var A
: SmallInt; Max
: SmallInt);
345 if A
+1 > Max
then A
:= Max
else A
:= A
+1;
348 procedure DecMin(var A
: Integer; Min
: Integer);
350 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
353 procedure DecMin(var A
: Single; Min
: Single);
355 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
358 procedure DecMin(var A
: Word; Min
: Word);
360 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
363 procedure DecMin(var A
: Byte; B
, Min
: Byte);
365 if A
-B
< Min
then A
:= Min
else A
:= A
-B
;
368 procedure DecMin(var A
: Byte; Min
: Byte); overload
;
370 if A
-1 < Min
then A
:= Min
else A
:= A
-1;
373 function Sign(A
: Integer): ShortInt;
375 if A
< 0 then Result
:= -1
376 else if A
> 0 then Result
:= 1
380 function Sign(A
: Single): ShortInt;
384 if Abs(A
) < Eps
then Result
:= 0
385 else if A
< 0 then Result
:= -1
389 function PointToRect(X
, Y
, X1
, Y1
: Integer; Width
, Height
: Word): Integer;
391 X
:= X
-X1
; // A(0;0) --- B(W;0)
396 if Y
< 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A
397 Result
:= Round(Hypot(X
, Y
))
399 if Y
> Height
then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D
400 Result
:= Round(Hypot(X
, Y
-Height
))
401 else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD
408 if y
< 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B
409 Result
:= Round(Hypot(X
, Y
))
411 if Y
> Height
then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C
412 Result
:= Round(Hypot(X
, Y
-Height
))
413 else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC
418 if Y
< 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB
421 if Y
> Height
then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC
423 else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0
428 function g_GetAcidHit(X
, Y
: Integer; Width
, Height
: Word): Byte;
430 tab
: array[0..3] of Byte = (0, 5, 10, 20);
436 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID1
, False) then a
:= a
or 1;
437 if g_Map_CollidePanel(X
, Y
, Width
, Height
, PANEL_ACID2
, False) then a
:= a
or 2;
442 function g_Look(a
, b
: PObj
; d
: TDirection
): Boolean;
444 if ((b
^.X
> a
^.X
) and (d
= D_LEFT
)) or
445 ((b
^.X
< a
^.X
) and (d
= D_RIGHT
)) then
451 Result
:= g_TraceVector(a
^.X
+a
^.Rect
.X
+(a
^.Rect
.Width
div 2),
452 a
^.Y
+a
^.Rect
.Y
+(a
^.Rect
.Height
div 2),
453 b
^.X
+b
^.Rect
.X
+(b
^.Rect
.Width
div 2),
454 b
^.Y
+b
^.Rect
.Y
+(b
^.Rect
.Height
div 2));
457 function GetAngle(baseX
, baseY
, pointX
, PointY
: Integer): SmallInt;
462 a
:= abs(pointX
-baseX
);
463 b
:= abs(pointY
-baseY
);
465 if a
= 0 then c
:= 90
466 else c
:= RadToDeg(ArcTan(b
/a
));
468 if pointY
< baseY
then c
:= -c
;
469 if pointX
> baseX
then c
:= 180-c
;
474 function GetAngle2(vx
, vy
: Integer): SmallInt;
485 c
:= RadToDeg(ArcTan(b
/a
));
497 {function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean;
499 table: array[0..8, 0..8] of Byte =
500 ((0, 0, 3, 3, 1, 2, 2, 0, 1),
501 (0, 0, 0, 0, 4, 7, 2, 0, 1),
502 (3, 0, 0, 0, 4, 4, 1, 3, 1),
503 (3, 0, 0, 0, 0, 0, 5, 6, 1),
504 (1, 4, 4, 0, 0, 0, 5, 5, 1),
505 (2, 7, 4, 0, 0, 0, 0, 0, 1),
506 (2, 2, 1, 5, 5, 0, 0, 0, 1),
507 (0, 0, 3, 6, 5, 0, 0, 0, 1),
508 (1, 1, 1, 1, 1, 1, 1, 1, 1));
510 function GetClass(x, y: Integer): Byte;
514 if x < rX then Result := 7
515 else if x < rX+rWidth then Result := 0
518 else if y < rY+rHeight then
520 if x < rX then Result := 6
521 else if x < rX+rWidth then Result := 8
526 if x < rX then Result := 5
527 else if x < rX+rWidth then Result := 4
533 case table[GetClass(x1, y1), GetClass(x2, y2)] of
536 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1));
537 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1));
538 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1));
539 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1));
540 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and
541 (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)));
542 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and
543 (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)));
544 else Result := False;
548 function g_CollideLine(x1
, y1
, x2
, y2
, rX
, rY
: Integer; rWidth
, rHeight
: Word): Boolean;
563 if dx
> 0 then incX
:= 1 else if dx
< 0 then incX
:= -1 else incX
:= 0;
564 if dy
> 0 then incY
:= 1 else if dy
< 0 then incY
:= -1 else incY
:= 0;
569 if dx
> dy
then d
:= dx
else d
:= dy
;
589 if (x
>= rX
) and (x
<= (rX
+ rWidth
- 1)) and
590 (y
>= rY
) and (y
<= (rY
+ rHeight
- 1)) then Exit
;
596 function GetStr(var Str
: string): string;
601 for a
:= 1 to Length(Str
) do
602 if (a
= Length(Str
)) or (Str
[a
+1] = ' ') then
604 Result
:= Copy(Str
, 1, a
);
611 {function GetLines(Text: string; MaxChars: Word): SArray;
619 while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' ');
623 SetLength(b, Length(b)+1);
624 b[High(b)] := GetStr(Text);
630 if a > High(b) then Break;
635 if Length(str) >= MaxChars then
639 SetLength(Result, Length(Result)+1);
640 Result[High(Result)] := Copy(str, 1, MaxChars);
641 Delete(str, 1, MaxChars);
647 while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do
653 SetLength(Result, Length(Result)+1);
654 Result[High(Result)] := str;
658 function GetLines(Text: string; FontID
: DWORD
; MaxWidth
: Word): SArray
;
660 function TextLen(Text: string): Word;
664 e_CharFont_GetSize(FontID
, Text, Result
, h
);
672 SetLength(Result
, 0);
677 // Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû:
678 while Pos(' ', Text) <> 0 do
679 Text := AnsiReplaceStr(Text, ' ', ' ');
683 SetLength(b
, Length(b
)+1);
684 b
[High(b
)] := GetStr(Text);
696 if TextLen(str
) > MaxWidth
then
697 begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì
700 SetLength(Result
, Length(Result
)+1);
703 while (c
< Length(str
)) and
704 (TextLen(Copy(str
, 1, c
+1)) < MaxWidth
) do
707 Result
[High(Result
)] := Copy(str
, 1, c
);
711 else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè
713 while (a
<= High(b
)) and
714 (TextLen(str
+' '+b
[a
]) < MaxWidth
) do
720 SetLength(Result
, Length(Result
)+1);
721 Result
[High(Result
)] := str
;
726 procedure Sort(var a
: SArray
);
731 if a
= nil then Exit
;
733 for i
:= High(a
) downto Low(a
) do
734 for j
:= Low(a
) to High(a
)-1 do
735 if LowerCase(a
[j
]) > LowerCase(a
[j
+1]) then
743 function Sscanf(const s
: String; const fmt
: String;
744 const Pointers
: array of Pointer): Integer;
751 function GetInt(): Integer;
754 while (n
<= Length(s
)) and (s
[n
] = ' ') do
757 while (n
<= Length(s
)) and (s
[n
] in ['0'..'9', '+', '-']) do
763 Result
:= Length(s1
);
766 function GetFloat(): Integer;
769 while (n
<= Length(s
)) and (s
[n
] = ' ') do
772 while (n
<= Length(s
)) and //jd >= rather than >
773 (s
[n
] in ['0'..'9', '+', '-', '.', 'e', 'E']) do
779 Result
:= Length(s1
);
782 function GetString(): Integer;
785 while (n
<= Length(s
)) and (s
[n
] = ' ') do
788 while (n
<= Length(s
)) and (s
[n
] <> ' ') do
794 Result
:= Length(s1
);
797 function ScanStr(c
: Char): Boolean;
799 while (n
<= Length(s
)) and (s
[n
] <> c
) do
803 Result
:= (n
<= Length(s
));
806 function GetFmt(): Integer;
812 while (fmt
[m
] = ' ') and (m
< Length(fmt
)) do
814 if (m
>= Length(fmt
)) then
817 if (fmt
[m
] = '%') then
821 'd': Result
:= vtInteger
;
822 'f': Result
:= vtExtended
;
823 's': Result
:= vtString
;
829 if (not ScanStr(fmt
[m
])) then
841 for i
:= 0 to High(Pointers
) do
850 L
:= StrToIntDef(s1
, 0);
851 Move(L
, Pointers
[i
]^, SizeOf(LongInt));
860 if GetFloat() > 0 then
862 X
:= StrToFloatDef(s1
, 0.0);
863 Move(X
, Pointers
[i
]^, SizeOf(Extended
));
872 if GetString() > 0 then
874 Move(s1
, Pointers
[i
]^, Length(s1
)+1);
887 function InDWArray(a
: DWORD
; arr
: DWArray
): Boolean;
893 if arr
= nil then Exit
;
895 for b
:= 0 to High(arr
) do
903 function InWArray(a
: Word; arr
: WArray
): Boolean;
909 if arr
= nil then Exit
;
911 for b
:= 0 to High(arr
) do
919 function InSArray(a
: string; arr
: SArray
): Boolean;
925 if arr
= nil then Exit
;
927 a
:= AnsiLowerCase(a
);
929 for b
:= 0 to High(arr
) do
930 if AnsiLowerCase(arr
[b
]) = a
then
937 function GetPos(UID
: Word; o
: PObj
): Boolean;
944 case g_GetUIDType(UID
) of
947 p
:= g_Player_Get(UID
);
948 if p
= nil then Exit
;
949 if not p
.Live
then Exit
;
956 m
:= g_Monsters_Get(UID
);
957 if m
= nil then Exit
;
958 if not m
.Live
then Exit
;
968 function parse(s
: String): SArray
;
978 for a
:= 1 to Length(s
) do
979 if (s
[a
] = ',') or (a
= Length(s
)) then
981 SetLength(Result
, Length(Result
)+1);
984 Result
[High(Result
)] := Copy(s
, 1, a
-1)
986 Result
[High(Result
)] := s
;
994 function parse2(s
: string; delim
: Char): SArray
;
1003 for a
:= 1 to Length(s
) do
1004 if (s
[a
] = delim
) or (a
= Length(s
)) then
1006 SetLength(Result
, Length(Result
)+1);
1008 if s
[a
] = delim
then Result
[High(Result
)] := Copy(s
, 1, a
-1)
1009 else Result
[High(Result
)] := s
;
1017 function g_GetFileTime(fileName
: String): Integer;
1021 if not FileExists(fileName
) then
1027 AssignFile(F
, fileName
);
1029 Result
:= FileGetDate(TFileRec(F
).Handle
);
1033 function g_SetFileTime(fileName
: String; time
: Integer): Boolean;
1037 if (not FileExists(fileName
)) or (time
< 0) then
1043 AssignFile(F
, fileName
);
1045 Result
:= (FileSetDate(TFileRec(F
).Handle
, time
) = 0);
1049 procedure SortSArray(var S
: SArray
);
1057 for i
:= Low(S
) to High(S
) - 1 do
1058 if S
[i
] > S
[i
+ 1] then begin
1067 function b_Text_Format(S
: string): string;
1075 for I
:= 1 to Length(S
) do
1077 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1087 Result
:= Result
+ #10;
1089 Result
:= Result
+ #1;
1091 Result
:= Result
+ #2;
1093 Result
:= Result
+ #3;
1095 Result
:= Result
+ #4;
1097 Result
:= Result
+ #18;
1099 Result
:= Result
+ #19;
1101 Result
:= Result
+ #20;
1103 Result
:= Result
+ #21;
1105 Result
:= Result
+ '\';
1107 Result
:= Result
+ '\' + S
[I
];
1111 Result
:= Result
+ S
[I
];
1113 // reset to white at end
1114 if Rst
then Result
:= Result
+ #2;
1117 function b_Text_Unformat(S
: string): string;
1124 for I
:= 1 to Length(S
) do
1126 if S
[I
] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then
1131 if (not Spec
) and (S
[I
] = '\') and (I
+ 1 <= Length(S
)) then
1148 '\': Result
:= Result
+ '\';
1150 Result
:= Result
+ '\' + S
[I
];
1154 Result
:= Result
+ S
[I
];