Subversion Repositories jumper

Rev

Rev 1 | Rev 11 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1 daniel-mar 1 
unit Functions;
2 
 
3 
interface
4 
 
5 
uses
6 
  SysUtils, Dialogs, Graphics, Classes, ExtCtrls;
7 
 
8 
function ExtractFileNameWithoutExt(filename: string): string;
9 
function SecondsToTimeString(Seconds: Integer): string;
10 
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
11 
function Ganzzahlig(num: extended): boolean;
12 
function Explode(Separator, Text: String): TStringList;
13 
function Position(FullString, Search: String): Integer;
14 
function ReadFile(InputFile: string): string;
15 
function RemoveLineBreaks(inp: string): string;
16 
 
17 
implementation
18 
 
19 
resourcestring
20 
  LNG_COULD_NOT_OPEN_FILE = 'Could not open file "%s".';
21 
 
22 
function ExtractFileNameWithoutExt(filename: string): string;
23 
begin
24 
  result := ExtractFileName(filename);
25 
  result := copy(result, 1, Length(result)-Length(ExtractFileExt(result)));
26 
end;
27 
 
28 
function SecondsToTimeString(Seconds: Integer): string;
29 
var
30 
  h, m, s: integer;
31 
  tim: TDateTime;
32 
begin
33 
  h := 0;
34 
  m := 0;
35 
  s := Seconds;
36 
 
37 
  while s - 60*60 >= 0 do
38 
  begin
39 
    dec(s, 60*60);
40 
    inc(h);
41 
  end;
42 
 
43 
  while s - 60 >= 0 do
44 
  begin
45 
    dec(s, 60);
46 
    inc(m);
47 
  end;
48 
 
49 
  tim := EncodeTime(h, m, s, 0);
50 
 
51 
  result := TimeToStr(tim);
52 
end;
53 
 
54 
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
55 
var
56 
  OldPenColor, OldBrushColor: TColor;
57 
begin
58 
  OldPenColor := Image.Canvas.Pen.Color;
59 
  OldBrushColor := Image.Canvas.Brush.Color;
60 
  Image.Canvas.Pen.Color := BackgroundColor;
61 
  Image.Canvas.Brush.Color := BackgroundColor;
62 
  Image.Canvas.Rectangle(0, 0, Image.Width, Image.Height);
63 
  Image.Canvas.Pen.Color := OldPenColor;
64 
  Image.Canvas.Brush.Color := OldBrushColor;
65 
end;
66 
 
67 
function Ganzzahlig(num: extended): boolean;
68 
begin
69 
  result := num = round(num);
70 
end;
71 
 
72 
function Explode(Separator, Text: String): TStringList;
73 
var
74 
  pos: integer;
75 
  tmp: string;
76 
begin
77 
  result := TStringList.Create;
78 
 
79 
  while Length(Text) > 0 do
80 
  begin
81 
    pos := Functions.Position(Text, Separator);
82 
 
83 
    if pos = -1 then
84 
    begin
85 
      tmp := Text;
86 
      Text := '';
87 
    end
88 
    else
89 
    begin
90 
      tmp := copy(Text, 1, pos-1);
91 
      Text := copy(Text, pos+1, Length(Text)-pos);
92 
    end;
93 
 
94 
    result.Add(tmp);
95 
  end;
96 
end;
97 
 
98 
function Position(FullString, Search: String): Integer;
99 
var
100 
  x: Integer;
101 
begin
102 
  x := Length(StrPos(PChar(FullString), PChar(Search)));
103 
  if x = 0 then
104 
    result := -1
105 
  else
106 
    result := Length(FullString) - x + 1;
107 
end;
108 
 
109 
function ReadFile(InputFile: string): string;
110 
var
111 
  f: textfile;
112 
  tmp: string;
113 
begin
114 
  result := '';
115 
 
116 
  if not FileExists(InputFile) then
117 
  begin
9 daniel-mar 118 
    MessageDlg(Format(LNG_COULD_NOT_OPEN_FILE, [InputFile]), mtError, [mbOk], 0);
1 daniel-mar 119 
    Exit;
120 
  end;
121 
 
122 
  AssignFile(f, InputFile);
123 
  Reset(f);
124 
  while not Eof(f) do
125 
  begin
126 
    ReadLn(f, tmp);
127 
    result := result + tmp + #13#10;
128 
  end;
129 
  CloseFile(f);
130 
end;
131 
 
132 
function RemoveLineBreaks(inp: string): string;
133 
begin
134 
  inp := StringReplace(inp, #13, '', [rfReplaceAll]);
135 
  inp := StringReplace(inp, #10, '', [rfReplaceAll]);
136 
  result := inp;
137 
end;
138 
 
139 
end.
140