Subversion Repositories jumper

Rev

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