home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / C / BC_502 / TESTDLL.PAK / UNIT2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-05-06  |  3.6 KB  |  164 lines
  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   StdCtrls, Forms, DBCtrls, DB, DBTables, Mask, ExtCtrls,
  8.   EmbForm, Ole2;
  9.  
  10. type
  11.   TForm3 = class(TEmbeddableForm)
  12.     Table1SiteID: TFloatField;
  13.     Table1Site: TStringField;
  14.     Table1Location: TStringField;
  15.     Table1When: TStringField;
  16.     Table1Airport: TStringField;
  17.     Table1TourismPeak: TStringField;
  18.     Table1Image: TGraphicField;
  19.     Table1Description: TMemoField;
  20.     Table1Contact: TStringField;
  21.     Table1Phone: TStringField;
  22.     ScrollBox: TScrollBox;
  23.     Label1: TLabel;
  24.     EditSiteID: TDBEdit;
  25.     Label2: TLabel;
  26.     EditSite: TDBEdit;
  27.     Label3: TLabel;
  28.     EditLocation: TDBEdit;
  29.     Label4: TLabel;
  30.     EditWhen: TDBEdit;
  31.     Label5: TLabel;
  32.     EditAirport: TDBEdit;
  33.     Label6: TLabel;
  34.     EditTourismPeak: TDBEdit;
  35.     Label8: TLabel;
  36.     EditDescription: TDBEdit;
  37.     Label9: TLabel;
  38.     EditContact: TDBEdit;
  39.     Label10: TLabel;
  40.     EditPhone: TDBEdit;
  41.     DBNavigator: TDBNavigator;
  42.     Panel1: TPanel;
  43.     DataSource1: TDataSource;
  44.     Panel2: TPanel;
  45.     Table1: TTable;
  46.     Label11: TLabel;
  47.     DBImage1: TDBImage;
  48.     procedure FormCreate(Sender: TObject);
  49.   private
  50.     { private declarations }
  51.   public
  52.     { public declarations }
  53.     function GoNext: Integer; stdcall;
  54.     function GoPrev: Integer; stdcall;
  55.   end;
  56.  
  57.   // Form interface definition
  58.   IMyObj = class(IUnknown)
  59.   public
  60.     function GoNext:Integer; virtual; stdcall; abstract;
  61.     function GoPrev: Integer; virtual; stdcall; abstract;
  62.   end;
  63.  
  64.   // Form interface implementation object
  65.   TMyFormInterface = class(IMyObj)
  66.   private
  67.     FCount: Integer;
  68.     FForm: TForm3;
  69.   public
  70.     constructor Create( AForm: TForm3 );
  71.     function QueryInterface(const iid: TIID; var obj): HResult; stdcall;
  72.     function AddRef: Longint; stdcall;
  73.     function Release: Longint; stdcall;
  74.     function GoNext: Integer; stdcall;
  75.     function GoPrev: Integer; stdcall;
  76.   end;
  77.  
  78.  
  79. function MakeTestForm( hWndParent: HWND; var obj: IUnknown ): HWND; stdcall;
  80.  
  81. var
  82.   Form3: TForm3;
  83.  
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. function MakeTestForm( hWndParent: HWND; var obj: IUnknown ): HWND; stdcall;
  90. var theForm: TForm3;
  91. begin
  92.     Application.CreateForm( TForm3, theForm );
  93.     theForm.ParentHandle := hWndParent;
  94.     Result := theForm.Handle;
  95.     TMyFormInterface.Create( theForm ).QueryInterface(IID_IUnknown, obj);
  96. // optionally, return another interface to the window, too
  97. end;
  98.  
  99.  
  100. // -------- Form interface ---------
  101. constructor TMyFormInterface.Create( AForm: TForm3 );
  102. begin
  103.   FForm := AForm;
  104.   FCount := 0;
  105. end;
  106.  
  107.  
  108. function TMyFormInterface.QueryInterface(const iid: TIID; var obj): HResult; stdcall;
  109. begin
  110.   AddRef;
  111.   IUnknown(obj) := self as IMyObj;
  112.   Result := S_OK;
  113. end;
  114.  
  115. function TMyFormInterface.AddRef: Longint; stdcall;
  116. begin
  117.   INC(FCount);
  118.   Result := FCount;
  119. end;
  120.  
  121. function TMyFormInterface.Release: Longint; stdcall;
  122. begin
  123.   DEC(FCount);
  124.   Result := FCount;
  125. end;
  126.  
  127. function TMyFormInterface.GoNext: Integer; stdcall;
  128. begin
  129.   Result := FForm.GoNext;
  130. end;
  131.  
  132. function TMyFormInterface.GoPrev: Integer; stdcall;
  133. begin
  134.   Result := FForm.GoPrev;
  135. end;
  136.  
  137. // ----------------- Form methods -----------------------
  138. procedure TForm3.FormCreate(Sender: TObject);
  139. begin
  140.   Table1.Open;
  141. end;
  142. // -------- Form methods ---------
  143. function TForm3.GoNext:Integer;
  144. begin
  145.   try
  146.     Table1.Next;
  147.     Result := 1;
  148.   except
  149.     Result := 0;
  150.   end;
  151. end;
  152.  
  153. function TForm3.GoPrev:Integer;
  154. begin
  155.   try
  156.    Table1.Prior;
  157.     Result := 1;
  158.   except
  159.     Result := 0;
  160.   end;
  161. end;
  162.  
  163. end.
  164.