Develop and Download Open Source Software

Browse Subversion Repository

Contents of /datalist.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Mon Nov 7 12:03:00 2011 UTC (12 years, 4 months ago) by shiraishikazuo
File MIME type: text/x-pascal
File size: 7674 byte(s)


1 unit datalist;
2 {$IFDEF FPC}
3 {$MODE DELPHI}{$H+}
4 {$ENDIF}
5
6 interface
7
8 uses
9 Classes, SysUtils,
10 base,textfile,arrays;
11
12 type
13 TDataList=Class(TStringList)
14 function InputData(ch:TTextDevice; const kindlist:ansistring;
15 option:IOoptions; const prompt:AnsiString;
16 timelimit:double; elapsed: PDouble;
17 insideofWhen:boolean; RecordSetter:tpRecordSetter;
18 LineNumb:integer ):boolean;
19 // recovery を実行すべきとき偽になる。
20 function ReadData(ch:TTextDevice; const kindlist:ansistring;
21 option:IOoptions; const prompt:AnsiString;
22 timelimit:double; elapsed: PDouble;
23 insideofWhen:boolean; RecordSetter:tpRecordSetter;
24 LineNumb:integer ):boolean;
25 // recovery を実行すべきとき偽になる。
26 function LineInput(ch:TTextDevice; const kindlist:ansistring;
27 option:IOoptions; const prompt:AnsiString;
28 timelimit:double; elapsed: PDouble;
29 insideofWhen:boolean; RecordSetter:tpRecordSetter;
30 LineNumb:integer ):boolean;
31 // recovery を実行すべきとき偽になる。
32 function CharacterInput(ch:TTextDevice; const kindlist:ansistring;
33 option:IOoptions; const prompt:AnsiString;
34 timelimit:double; elapsed: PDouble;
35 insideofWhen:boolean; RecordSetter:tpRecordSetter;
36 LineNumb:integer ):boolean;
37 // recovery を実行すべきとき偽になる。
38 function InputVarilen(ch:TTextDevice; const kindlist:ansistring;
39 option:IOoptions; const prompt:AnsiString;
40 timelimit:double; elapsed: PDouble;
41 insideofWhen:boolean; RecordSetter:tpRecordSetter;
42 LineNumb:integer ):boolean;
43 // recovery を実行すべきとき偽になる。
44 procedure AssignData(a:Array of Const);
45 procedure AssignVarilen(a:TArray1);
46 end;
47 implementation
48
49 function TDataList.InputData( ch:TTextDevice; const kindlist:ansistring;
50 option:IOoptions; const prompt:AnsiString;
51 timelimit:double; elapsed: PDouble;
52 insideofWhen:boolean; RecordSetter:tpRecordSetter;
53 LineNumb:integer ):boolean;
54 var
55 StartTime:Double;
56 begin
57 if TimeLimit<0 then
58 setexception(8402);
59 starttime:=now;
60
61 if ch=nil then setexception(7004);
62 ch.CheckForInput(option);
63 ch.initInput(LineNumb,prompt,now+timelimit/86400. );
64 ch.Setpointer(RecordSetter,insideofWhen);
65 result:=ch.DataFoundForRead;
66 if result then
67 ch.InputData(self,kindlist,option);
68
69 if (elapsed <> nil) and (extype<>8401) then
70 elapsed^:=(now-starttime)*86400. ;
71
72 end;
73
74 function TDataList.readData( ch:TTextDevice; const kindlist:ansistring;
75 option:IOoptions; const prompt:AnsiString;
76 timelimit:double; elapsed: PDouble;
77 insideofWhen:boolean; RecordSetter:tpRecordSetter;
78 LineNumb:integer ):boolean;
79 var
80 StartTime:Double;
81 begin
82 if TimeLimit<0 then
83 setexception(8402);
84 starttime:=now;
85
86 if ch=nil then setexception(7004);
87 ch.CheckForInput(option);
88 //ch.initInput(LineNumb,prompt,now+timelimit/86400. );
89 ch.Setpointer(RecordSetter,insideofWhen);
90 result:=ch.DataFoundForRead;
91 if result then
92 ch.ReadData(self,kindlist,option);
93
94 if (elapsed <> nil) and (extype<>8401) then
95 elapsed^:=(now-starttime)*86400. ;
96
97 end;
98
99 function TDataList.LineInput( ch:TTextDevice; const kindlist:ansistring;
100 option:IOoptions; const prompt:AnsiString;
101 timelimit:double; elapsed: PDouble;
102 insideofWhen:boolean; RecordSetter:tpRecordSetter;
103 LineNumb:integer ):boolean;
104 var
105 StartTime:Double;
106 begin
107 if TimeLimit<0 then
108 setexception(8402);
109 starttime:=now;
110
111 if ch=nil then setexception(7004);
112 ch.CheckForInput(option);
113 ch.initInput(LineNumb,prompt,now+timelimit/86400. );
114 ch.Setpointer(RecordSetter,insideofWhen);
115 result:=ch.DataFoundForRead;
116 if result then
117 ch.LineInput(self,length(kindlist),option);
118
119 if (elapsed <> nil) and (extype<>8401) then
120 elapsed^:=(now-starttime)*86400. ;
121
122 end;
123
124 function TDataList.CharacterInput( ch:TTextDevice; const kindlist:ansistring;
125 option:IOoptions; const prompt:AnsiString;
126 timelimit:double; elapsed: PDouble;
127 insideofWhen:boolean; RecordSetter:tpRecordSetter;
128 LineNumb:integer ):boolean;
129 var
130 StartTime:Double;
131 s:string;
132 begin
133 if TimeLimit<0 then
134 setexception(8402);
135 starttime:=now;
136
137 if ch=nil then setexception(7004);
138 ch.CheckForInput(option);
139 ch.initInput(LineNumb,prompt,now+timelimit/86400. );
140 ch.Setpointer(RecordSetter,insideofWhen);
141 result:=ch.DataFoundForRead;
142 if result then
143 begin
144 ch.CharacterInput(s,option);
145 self.add(s);
146 if (ioNoWait in option) and (s='') then
147 begin
148 base.extype:=0; // exception発生を抑止
149 result:=false;
150 end;
151 end;
152
153 if (elapsed <> nil) and (extype<>8401) then
154 elapsed^:=(now-starttime)*86400. ;
155
156
157 end;
158
159 function TDataList.InputVarilen( ch:TTextDevice; const kindlist:ansistring;
160 option:IOoptions; const prompt:AnsiString;
161 timelimit:double; elapsed: PDouble;
162 insideofWhen:boolean; RecordSetter:tpRecordSetter;
163 LineNumb:integer ):boolean;
164 var
165 StartTime:Double;
166 count:integer;
167 begin
168 if TimeLimit<0 then
169 setexception(8402);
170 starttime:=now;
171
172 if ch=nil then setexception(7004);
173 ch.CheckForInput(option);
174 ch.initInput(LineNumb,prompt,now+timelimit/86400. );
175 ch.Setpointer(RecordSetter,insideofWhen);
176 result:=ch.DataFoundForRead;
177 if result then
178 ch.InputVarilen(self,kindlist,option,count);
179
180 if (elapsed <> nil) and (extype<>8401) then
181 elapsed^:=(now-starttime)*86400. ;
182
183 end;
184
185 procedure TDataList.AssignData(a:Array of Const); //aはTArrayの配列
186 var
187 p:integer;
188 i:integer;
189 begin
190 p:=0;
191 for i:=0 to HIGH(a) do
192 with a[i] do
193 case VType of
194 vtObject:(VObject as TArray).read(self,p);
195 end;
196 end;
197
198 procedure TDataList.AssignVarilen(a:TArray1);
199 begin
200 a.AssignVarilen(self)
201 end;
202
203
204 end.
205

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26