source/COM/_StEclipses.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{
  TODO:
   1. What is the 'Path' of TStEclipseRecord?
}

unit _StEclipses;

interface

uses
  Windows, ComObj, ActiveX, StEclpse, SysTools_TLB;

type
  TStEclipseRecord = class(TAutoIntfObject, IStEclipseRecord)
   private
     FOwner : StEclpse.TStEclipseRecord;
   public
    constructor Create(AOwner: StEclpse.TStEclipseRecord);
   protected
    function Get_EType: TStEclipseType; safecall;
    function Get_Magnitude: Double; safecall;
    function Get_Hemisphere: TStHemisphereType; safecall;
    function Get_LContacts: IStContactTimes; safecall;
    function Get_Path: OleVariant; safecall;
  end;

  TStContactTimes = class(TAutoIntfObject, IStContactTimes)
   private
     FOwner : StEclpse.TStContactTimes;
   public
    constructor Create(AOwner: StEclpse.TStContactTimes);
   protected
    function Get_UT1: TDateTime; safecall;
    function Get_UT2: TDateTime; safecall;
    function Get_FirstContact: TDateTime; safecall;
    function Get_SecondContact: TDateTime; safecall;
    function Get_MidEclipse: TDateTime; safecall;
    function Get_ThirdContact: TDateTime; safecall;
    function Get_FourthContact: TDateTime; safecall;
  end;

  TStEclipses = class(TAutoObject, IStEclipses, IEnumVariant)
   private
    FOwner : StEclpse.TStEclipses;
    FEnumPos : Integer;
   public
    procedure Initialize; override;
    destructor Destroy; override;
   protected
    function Get__NewEnum: IUnknown; safecall;

    { IEnumVariant }
    function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
    function Skip(celt: LongInt): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out Enum: IEnumVariant): HResult; stdcall;

    function Get_Eclipses(Index: Integer): IStEclipseRecord; safecall;
    procedure FindEclipses(Year: Integer); safecall;
    function Get_Count: Integer; safecall;
  end;

implementation

uses ComServ, StList;

constructor TStEclipseRecord.Create(AOwner: StEclpse.TStEclipseRecord);
begin
  inherited  Create(ComServer.TypeLib, IStEclipseRecord);
  FOwner := AOwner;
end;

function TStEclipseRecord.Get_EType: TStEclipseType;
begin
  Result := TStEclipseType(FOwner.EType);
end;

function TStEclipseRecord.Get_Magnitude: Double;
begin
  Result := FOwner.Magnitude;
end;

function TStEclipseRecord.Get_Hemisphere: TStHemisphereType;
begin
  Result := TStHemisphereType(FOwner.Hemisphere);
end;

function TStEclipseRecord.Get_LContacts: IStContactTimes;
begin
  Result := TStContactTimes.Create(FOwner.LContacts);
end;

function TStEclipseRecord.Get_Path: OleVariant;
begin
//  Result := 0;
end;


constructor TStContactTimes.Create(AOwner: StEclpse.TStContactTimes);
begin
  inherited  Create(ComServer.TypeLib, IStContactTimes);
  FOwner := AOwner;
end;

function TStContactTimes.Get_UT1: TDateTime;
begin
  Result := FOwner.UT1;
end;

function TStContactTimes.Get_UT2: TDateTime;
begin
  Result := FOwner.UT2;
end;

function TStContactTimes.Get_FirstContact: TDateTime;
begin
  Result := FOwner.FirstContact;
end;

function TStContactTimes.Get_SecondContact: TDateTime;
begin
  Result := FOwner.SecondContact;
end;

function TStContactTimes.Get_MidEclipse: TDateTime;
begin
  Result := FOwner.MidEclipse;
end;

function TStContactTimes.Get_ThirdContact: TDateTime;
begin
  Result := FOwner.ThirdContact;
end;

function TStContactTimes.Get_FourthContact: TDateTime;
begin
  Result := FOwner.FourthContact;
end;

procedure TStEclipses.Initialize;
begin
  inherited Initialize;
  FOwner := StEclpse.TStEclipses.Create(TStListNode);
  FEnumPos := 0;
end;

destructor TStEclipses.Destroy;
begin
  FOwner.Free;
  inherited Destroy;
end;

function TStEclipses.Get__NewEnum: IUnknown;
begin
  Result := Self;
end;

function TStEclipses.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult;
var
  V : OleVariant;
  I : Integer;
begin
  Result := S_FALSE;
  try
    if pceltFetched <> nil then
      pceltFetched^ := 0;
    for I := 0 to celt - 1 do begin
      if FEnumPos >= FOwner.Count then begin
        FEnumPos := 0;
        Exit;
      end;
      V := Get_Eclipses(FEnumPos);
      TVariantArgList(elt)[I] := TVariantArg(V);

      // Prevent COM garbage collection
      TVarData(V).VType := varEmpty;
      TVarData(V).VInteger := 0;

      Inc(FEnumPos);
      if pceltFetched <> nil then
        Inc(pceltFetched^);
    end;
  except
  end;
  if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
   Result := S_OK;
end;

function TStEclipses.Skip(celt: LongInt): HResult;
begin
  Inc(FEnumPos, celt);
  Result := S_OK;
end;

function TStEclipses.Reset: HResult;
begin
  FEnumPos := 0;
  Result := S_OK;
end;

function TStEclipses.Clone(out Enum: IEnumVariant): HResult;
begin
  Enum := nil;
  Result := S_OK;
  try
    Enum := Self.Create;
    TStEclipses(Enum).FOwner := FOwner;
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TStEclipses.Get_Eclipses(Index: Integer): IStEclipseRecord;
begin
  Result := TStEclipseRecord.Create(FOwner.Eclipses[Index]^);
end;

procedure TStEclipses.FindEclipses(Year: Integer);
begin
  FOwner.FindEclipses(Year);
end;

function TStEclipses.Get_Count: Integer;
begin
  Result := FOwner.Count;
end;

initialization
  TAutoObjectFactory.Create(ComServer, TStEclipses, Class_StEclipses, ciMultiInstance, tmBoth);
end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	{
27	TODO:
28	1. What is the 'Path' of TStEclipseRecord?
29	}
30
31	unit _StEclipses;
32
33	interface
34
35	uses
36	Windows, ComObj, ActiveX, StEclpse, SysTools_TLB;
37
38	type
39	TStEclipseRecord = class(TAutoIntfObject, IStEclipseRecord)
40	private
41	FOwner : StEclpse.TStEclipseRecord;
42	public
43	constructor Create(AOwner: StEclpse.TStEclipseRecord);
44	protected
45	function Get_EType: TStEclipseType; safecall;
46	function Get_Magnitude: Double; safecall;
47	function Get_Hemisphere: TStHemisphereType; safecall;
48	function Get_LContacts: IStContactTimes; safecall;
49	function Get_Path: OleVariant; safecall;
50	end;
51
52	TStContactTimes = class(TAutoIntfObject, IStContactTimes)
53	private
54	FOwner : StEclpse.TStContactTimes;
55	public
56	constructor Create(AOwner: StEclpse.TStContactTimes);
57	protected
58	function Get_UT1: TDateTime; safecall;
59	function Get_UT2: TDateTime; safecall;
60	function Get_FirstContact: TDateTime; safecall;
61	function Get_SecondContact: TDateTime; safecall;
62	function Get_MidEclipse: TDateTime; safecall;
63	function Get_ThirdContact: TDateTime; safecall;
64	function Get_FourthContact: TDateTime; safecall;
65	end;
66
67	TStEclipses = class(TAutoObject, IStEclipses, IEnumVariant)
68	private
69	FOwner : StEclpse.TStEclipses;
70	FEnumPos : Integer;
71	public
72	procedure Initialize; override;
73	destructor Destroy; override;
74	protected
75	function Get__NewEnum: IUnknown; safecall;
76
77	{ IEnumVariant }
78	function Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult; stdcall;
79	function Skip(celt: LongInt): HResult; stdcall;
80	function Reset: HResult; stdcall;
81	function Clone(out Enum: IEnumVariant): HResult; stdcall;
82
83	function Get_Eclipses(Index: Integer): IStEclipseRecord; safecall;
84	procedure FindEclipses(Year: Integer); safecall;
85	function Get_Count: Integer; safecall;
86	end;
87
88	implementation
89
90	uses ComServ, StList;
91
92	constructor TStEclipseRecord.Create(AOwner: StEclpse.TStEclipseRecord);
93	begin
94	inherited Create(ComServer.TypeLib, IStEclipseRecord);
95	FOwner := AOwner;
96	end;
97
98	function TStEclipseRecord.Get_EType: TStEclipseType;
99	begin
100	Result := TStEclipseType(FOwner.EType);
101	end;
102
103	function TStEclipseRecord.Get_Magnitude: Double;
104	begin
105	Result := FOwner.Magnitude;
106	end;
107
108	function TStEclipseRecord.Get_Hemisphere: TStHemisphereType;
109	begin
110	Result := TStHemisphereType(FOwner.Hemisphere);
111	end;
112
113	function TStEclipseRecord.Get_LContacts: IStContactTimes;
114	begin
115	Result := TStContactTimes.Create(FOwner.LContacts);
116	end;
117
118	function TStEclipseRecord.Get_Path: OleVariant;
119	begin
120	// Result := 0;
121	end;
122
123
124	constructor TStContactTimes.Create(AOwner: StEclpse.TStContactTimes);
125	begin
126	inherited Create(ComServer.TypeLib, IStContactTimes);
127	FOwner := AOwner;
128	end;
129
130	function TStContactTimes.Get_UT1: TDateTime;
131	begin
132	Result := FOwner.UT1;
133	end;
134
135	function TStContactTimes.Get_UT2: TDateTime;
136	begin
137	Result := FOwner.UT2;
138	end;
139
140	function TStContactTimes.Get_FirstContact: TDateTime;
141	begin
142	Result := FOwner.FirstContact;
143	end;
144
145	function TStContactTimes.Get_SecondContact: TDateTime;
146	begin
147	Result := FOwner.SecondContact;
148	end;
149
150	function TStContactTimes.Get_MidEclipse: TDateTime;
151	begin
152	Result := FOwner.MidEclipse;
153	end;
154
155	function TStContactTimes.Get_ThirdContact: TDateTime;
156	begin
157	Result := FOwner.ThirdContact;
158	end;
159
160	function TStContactTimes.Get_FourthContact: TDateTime;
161	begin
162	Result := FOwner.FourthContact;
163	end;
164
165	procedure TStEclipses.Initialize;
166	begin
167	inherited Initialize;
168	FOwner := StEclpse.TStEclipses.Create(TStListNode);
169	FEnumPos := 0;
170	end;
171
172	destructor TStEclipses.Destroy;
173	begin
174	FOwner.Free;
175	inherited Destroy;
176	end;
177
178	function TStEclipses.Get__NewEnum: IUnknown;
179	begin
180	Result := Self;
181	end;
182
183	function TStEclipses.Next(celt: LongInt; out elt; pceltFetched: PLongInt): HResult;
184	var
185	V : OleVariant;
186	I : Integer;
187	begin
188	Result := S_FALSE;
189	try
190	if pceltFetched <> nil then
191	pceltFetched^ := 0;
192	for I := 0 to celt - 1 do begin
193	if FEnumPos >= FOwner.Count then begin
194	FEnumPos := 0;
195	Exit;
196	end;
197	V := Get_Eclipses(FEnumPos);
198	TVariantArgList(elt)[I] := TVariantArg(V);
199
200	// Prevent COM garbage collection
201	TVarData(V).VType := varEmpty;
202	TVarData(V).VInteger := 0;
203
204	Inc(FEnumPos);
205	if pceltFetched <> nil then
206	Inc(pceltFetched^);
207	end;
208	except
209	end;
210	if (pceltFetched = nil) or ((pceltFetched <> nil) and (pceltFetched^ = celt)) then
211	Result := S_OK;
212	end;
213
214	function TStEclipses.Skip(celt: LongInt): HResult;
215	begin
216	Inc(FEnumPos, celt);
217	Result := S_OK;
218	end;
219
220	function TStEclipses.Reset: HResult;
221	begin
222	FEnumPos := 0;
223	Result := S_OK;
224	end;
225
226	function TStEclipses.Clone(out Enum: IEnumVariant): HResult;
227	begin
228	Enum := nil;
229	Result := S_OK;
230	try
231	Enum := Self.Create;
232	TStEclipses(Enum).FOwner := FOwner;
233	except
234	Result := E_OUTOFMEMORY;
235	end;
236	end;
237
238	function TStEclipses.Get_Eclipses(Index: Integer): IStEclipseRecord;
239	begin
240	Result := TStEclipseRecord.Create(FOwner.Eclipses[Index]^);
241	end;
242
243	procedure TStEclipses.FindEclipses(Year: Integer);
244	begin
245	FOwner.FindEclipses(Year);
246	end;
247
248	function TStEclipses.Get_Count: Integer;
249	begin
250	Result := FOwner.Count;
251	end;
252
253	initialization
254	TAutoObjectFactory.Create(ComServer, TStEclipses, Class_StEclipses, ciMultiInstance, tmBoth);
255	end.