WebSVN – jumper – Diff – /trunk/Functions.pas


unit Functions;
 
interface
 
uses
  SysUtils, Dialogs, Graphics, Classes, ExtCtrls;
 
function ExtractFileNameWithoutExt(filename: string): string;
function SecondsToTimeString(Seconds: Integer): string;
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
function Ganzzahlig(num: extended): boolean;
function Explode(Separator, Text: String): TStringList;
function Position(FullString, Search: String): Integer;
function ReadFile(InputFile: string): string;
 
 
implementation
 
resourcestring
  LNG_COULD_NOT_OPEN_FILE = 'Could not open file "%s".';
 
function ExtractFileNameWithoutExt(filename: string): string;
begin
  result := ExtractFileName(filename);
  result := copy(result, 1, Length(result)-Length(ExtractFileExt(result)));
end;
 
function SecondsToTimeString(Seconds: Integer): string;
var
  h, m, s: integer;
  tim: TDateTime;
begin
  h := 0;
  m := 0;
  s := Seconds;
 
  while s - 60*60 >= 0 do
  begin
    dec(s, 60*60);
    inc(h);
  end;
 
  while s - 60 >= 0 do
  begin
    dec(s, 60);
    inc(m);
  end;
 
  tim := EncodeTime(h, m, s, 0);
 
  result := TimeToStr(tim);
end;
 
procedure ClearImage(Image: TImage; BackgroundColor: TColor);
var
  OldPenColor, OldBrushColor: TColor;
begin
  OldPenColor := Image.Canvas.Pen.Color;
  OldBrushColor := Image.Canvas.Brush.Color;
  Image.Canvas.Pen.Color := BackgroundColor;
  Image.Canvas.Brush.Color := BackgroundColor;
  Image.Canvas.Rectangle(0, 0, Image.Width, Image.Height);
  Image.Canvas.Pen.Color := OldPenColor;
  Image.Canvas.Brush.Color := OldBrushColor;
end;
 
function Ganzzahlig(num: extended): boolean;
begin
  result := num = round(num);
end;
 
function Explode(Separator, Text: String): TStringList;
var
  pos: integer;
  tmp: string;
begin
  result := TStringList.Create;
 
  while Length(Text) > 0 do
  begin
    pos := Functions.Position(Text, Separator);
 
    if pos = -1 then
    begin
      tmp := Text;
      Text := '';
    end
    else
    begin
      tmp := copy(Text, 1, pos-1);
      Text := copy(Text, pos+1, Length(Text)-pos);
    end;
 
    result.Add(tmp);
  end;
end;
 
function Position(FullString, Search: String): Integer;
var
  x: Integer;
begin
  x := Length(StrPos(PChar(FullString), PChar(Search)));
  if x = 0 then
    result := -1
  else
    result := Length(FullString) - x + 1;
end;
 
function ReadFile(InputFile: string): string;
var
  f: textfile;
  tmp: string;
begin
  result := '';
 
  if not FileExists(InputFile) then
  begin
    MessageDlg(Format(LNG_COULD_NOT_OPEN_FILE, [InputFile]), mtError, [mbOk], 0);
    Exit;
  end;
 
  AssignFile(f, InputFile);
  Reset(f);
  while not Eof(f) do
  begin
    ReadLn(f, tmp);
    result := result + tmp + #13#10;
  end;
  CloseFile(f);
end;
 
 
 
 
 
 
 
 
end.
 

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

Subversion Repositories jumper

jumper/trunk/Functions.pas – Rev 9 → 11