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	torben	2671	(* *** 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.