Skip to content

Commit cfb5a8f

Browse files
Add files via upload
1 parent e3eee31 commit cfb5a8f

File tree

1 file changed

+157
-0
lines changed

1 file changed

+157
-0
lines changed

initvars.lpr

Lines changed: 157 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,157 @@
1+
program initvars;
2+
3+
{$mode objfpc}{$H+}
4+
5+
uses
6+
{$IFDEF UNIX}
7+
cthreads,
8+
{$ENDIF}
9+
Classes, SysUtils, CustApp
10+
{ you can add units after this };
11+
12+
type
13+
14+
{ TPointClass }
15+
16+
TPointClass = class
17+
private
18+
X, Y: integer;
19+
FItems: TStringList;
20+
public
21+
constructor Create(AX, AY: integer);
22+
destructor Destroy; override;
23+
property X_: integer read X;
24+
property Y_: integer read Y;
25+
end;
26+
27+
{Code starts here for TPointClass}
28+
constructor TPointClass.Create(AX, AY: integer);
29+
begin
30+
inherited Create;
31+
WriteLn('In TPointClass.Create');
32+
if (AX <= 0) or (AY <= 0) then
33+
raise Exception.Create('AX or AY <= 0');
34+
35+
X := AX;
36+
Y := AY;
37+
FItems := TStringList.Create;
38+
39+
WriteLn('TPointClass.Create completed');
40+
end;
41+
42+
destructor TPointClass.Destroy;
43+
begin
44+
inherited Destroy;
45+
WriteLn('In TPointClass.Destroy');
46+
if Assigned(FItems) then
47+
begin
48+
WriteLn('TPointClass.Destroy::free FItems');
49+
FItems.Free;
50+
end;
51+
end;
52+
53+
{Second test case}
54+
55+
function FindStreamHandler(filename: string): TStream;
56+
begin
57+
result := Nil;
58+
end;
59+
60+
procedure DoSomething(filename: string);
61+
var
62+
stream: TStream;
63+
LItems: TStringlist;
64+
begin
65+
stream := FindStreamHandler(filename);
66+
67+
if not Assigned(stream) then
68+
raise Exception.Create('Could not find handler for ' + filename);
69+
70+
stream.Seek(0, soFromBeginning);
71+
stream.Free;
72+
end;
73+
74+
{Main test case(s)}
75+
76+
procedure Main;
77+
var
78+
LI: integer = 1;
79+
LDouble: double = 3.14;
80+
LStr: string;
81+
LPoint: TPoint;
82+
LPt: TPointClass;
83+
begin
84+
//TestInt;
85+
86+
WriteLn('Test #1');
87+
WriteLn('Value of LI -');
88+
WriteLn(LI);
89+
WriteLn('-------------------------');
90+
91+
WriteLn('Test #2');
92+
WriteLn('Value of LDouble -');
93+
WriteLn(LDouble);
94+
WriteLn('-------------------------');
95+
96+
Exit;
97+
98+
LPoint := Default(TPoint);
99+
WriteLn('Test #3');
100+
WriteLn('Value of LPoint -');
101+
WriteLn(LPoint.X, ' ', LPoint.Y);
102+
WriteLn('-------------------------');
103+
104+
WriteLn('Test #4');
105+
WriteLn('Value of LStr -');
106+
WriteLn('[' + LStr + ']');
107+
WriteLn('-------------------------');
108+
109+
{
110+
WriteLn('Test #5');
111+
LPt := Default(TPointClass);
112+
WriteLn('"Value" of LPt -');
113+
WriteLn(BoolToStr(Assigned(LPt), True));
114+
WriteLn('-------------------------');
115+
}
116+
117+
WriteLn('Test #6');
118+
try
119+
LPt := TPointClass.Create(0,0);
120+
try
121+
WriteLn('LPt.X=' + LPt.X.ToString);
122+
except
123+
on e: Exception do
124+
WriteLn('Exception (3): ' + e.Message);
125+
end;
126+
except
127+
on e: Exception do
128+
begin
129+
WriteLn('Exception (2): ' + e.Message);
130+
LPt := nil;
131+
end;
132+
end;
133+
134+
if Assigned(LPt) then
135+
begin
136+
WriteLn('LPt is assigned?');
137+
//WriteLn('LObj.ClassName=' + LObj.ClassName); {raises exception!}
138+
end
139+
else
140+
WriteLn('LPt is NOT assigned?');
141+
WriteLn('-------------------------');
142+
end;
143+
144+
begin
145+
try
146+
Main;
147+
//DoSomething('xxx.log');
148+
except
149+
on e: Exception do
150+
WriteLn('Exception (1): ' + e.Message);
151+
end;
152+
153+
readln;
154+
end.
155+
156+
157+

0 commit comments

Comments
 (0)