TLibDemo_TLB.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:10k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit TLibDemo_TLB;
  2. // ************************************************************************ //
  3. // WARNING                                                                    
  4. // -------                                                                    
  5. // The types declared in this file were generated from data read from a       
  6. // Type Library. If this type library is explicitly or indirectly (via        
  7. // another type library referring to this type library) re-imported, or the   
  8. // 'Refresh' command of the Type Library Editor activated while editing the   
  9. // Type Library, the contents of this file will be regenerated and all        
  10. // manual modifications will be lost.                                         
  11. // ************************************************************************ //
  12. // PASTLWTR : $Revision:   1.130  $
  13. // File generated on 6/21/2001 7:04:50 PM from Type Library described below.
  14. // ************************************************************************  //
  15. // Type Lib: C:md6code20TLibDemoTlibdemo.tlb (1)
  16. // LIBID: {89855B41-8EFE-11D0-98D0-444553540000}
  17. // LCID: 0
  18. // Helpfile: 
  19. // DepndLst: 
  20. //   (1) v1.0 stdole, (C:WINDOWSSystem32stdole32.tlb)
  21. //   (2) v2.0 StdType, (C:WINDOWSSystem32OLEPRO32.DLL)
  22. //   (3) v1.0 StdVCL, (C:Program FilesX-SetupbinSTDVCL32.DLL)
  23. // ************************************************************************ //
  24. // *************************************************************************//
  25. // NOTE:                                                                      
  26. // Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties  
  27. // which return objects that may need to be explicitly created via a function 
  28. // call prior to any access via the property. These items have been disabled  
  29. // in order to prevent accidental use from within the object inspector. You   
  30. // may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively   
  31. // removing them from the $IFDEF blocks. However, such items must still be    
  32. // programmatically created via a method of the appropriate CoClass before    
  33. // they can be used.                                                          
  34. {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
  35. {$WARN SYMBOL_PLATFORM OFF}
  36. {$WRITEABLECONST ON}
  37. interface
  38. uses ActiveX, Classes, Graphics, OleServer, StdVCL, Variants, Windows;
  39.   
  40. // *********************************************************************//
  41. // GUIDS declared in the TypeLibrary. Following prefixes are used:        
  42. //   Type Libraries     : LIBID_xxxx                                      
  43. //   CoClasses          : CLASS_xxxx                                      
  44. //   DISPInterfaces     : DIID_xxxx                                       
  45. //   Non-DISP interfaces: IID_xxxx                                        
  46. // *********************************************************************//
  47. const
  48.   // TypeLibrary Major and minor versions
  49.   TLibDemoMajorVersion = 1;
  50.   TLibDemoMinorVersion = 0;
  51.   LIBID_TLibDemo: TGUID = '{89855B41-8EFE-11D0-98D0-444553540000}';
  52.   IID_IFirstServer: TGUID = '{89855B42-8EFE-11D0-98D0-444553540000}';
  53.   CLASS_FirstServer: TGUID = '{89855B43-8EFE-11D0-98D0-444553540000}';
  54. type
  55. // *********************************************************************//
  56. // Forward declaration of types defined in TypeLibrary                    
  57. // *********************************************************************//
  58.   IFirstServer = interface;
  59.   IFirstServerDisp = dispinterface;
  60. // *********************************************************************//
  61. // Declaration of CoClasses defined in Type Library                       
  62. // (NOTE: Here we map each CoClass to its Default Interface)              
  63. // *********************************************************************//
  64.   FirstServer = IFirstServer;
  65. // *********************************************************************//
  66. // Interface: IFirstServer
  67. // Flags:     (4432) Hidden Dual OleAutomation Dispatchable
  68. // GUID:      {89855B42-8EFE-11D0-98D0-444553540000}
  69. // *********************************************************************//
  70.   IFirstServer = interface(IDispatch)
  71.     ['{89855B42-8EFE-11D0-98D0-444553540000}']
  72.     procedure ChangeColor; safecall;
  73.     function  Get_Value: Integer; safecall;
  74.     procedure Set_Value(Value: Integer); safecall;
  75.     property Value: Integer read Get_Value write Set_Value;
  76.   end;
  77. // *********************************************************************//
  78. // DispIntf:  IFirstServerDisp
  79. // Flags:     (4432) Hidden Dual OleAutomation Dispatchable
  80. // GUID:      {89855B42-8EFE-11D0-98D0-444553540000}
  81. // *********************************************************************//
  82.   IFirstServerDisp = dispinterface
  83.     ['{89855B42-8EFE-11D0-98D0-444553540000}']
  84.     procedure ChangeColor; dispid 1;
  85.     property Value: Integer dispid 2;
  86.   end;
  87. // *********************************************************************//
  88. // The Class CoFirstServer provides a Create and CreateRemote method to          
  89. // create instances of the default interface IFirstServer exposed by              
  90. // the CoClass FirstServer. The functions are intended to be used by             
  91. // clients wishing to automate the CoClass objects exposed by the         
  92. // server of this typelibrary.                                            
  93. // *********************************************************************//
  94.   CoFirstServer = class
  95.     class function Create: IFirstServer;
  96.     class function CreateRemote(const MachineName: string): IFirstServer;
  97.   end;
  98. // *********************************************************************//
  99. // OLE Server Proxy class declaration
  100. // Server Object    : TFirstServer
  101. // Help String      : FirstServerObject
  102. // Default Interface: IFirstServer
  103. // Def. Intf. DISP? : No
  104. // Event   Interface: 
  105. // TypeFlags        : (2) CanCreate
  106. // *********************************************************************//
  107. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  108.   TFirstServerProperties= class;
  109. {$ENDIF}
  110.   TFirstServer = class(TOleServer)
  111.   private
  112.     FIntf:        IFirstServer;
  113. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  114.     FProps:       TFirstServerProperties;
  115.     function      GetServerProperties: TFirstServerProperties;
  116. {$ENDIF}
  117.     function      GetDefaultInterface: IFirstServer;
  118.   protected
  119.     procedure InitServerData; override;
  120.     function  Get_Value: Integer;
  121.     procedure Set_Value(Value: Integer);
  122.   public
  123.     constructor Create(AOwner: TComponent); override;
  124.     destructor  Destroy; override;
  125.     procedure Connect; override;
  126.     procedure ConnectTo(svrIntf: IFirstServer);
  127.     procedure Disconnect; override;
  128.     procedure ChangeColor;
  129.     property  DefaultInterface: IFirstServer read GetDefaultInterface;
  130.     property Value: Integer read Get_Value write Set_Value;
  131.   published
  132. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  133.     property Server: TFirstServerProperties read GetServerProperties;
  134. {$ENDIF}
  135.   end;
  136. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  137. // *********************************************************************//
  138. // OLE Server Properties Proxy Class
  139. // Server Object    : TFirstServer
  140. // (This object is used by the IDE's Property Inspector to allow editing
  141. //  of the properties of this server)
  142. // *********************************************************************//
  143.  TFirstServerProperties = class(TPersistent)
  144.   private
  145.     FServer:    TFirstServer;
  146.     function    GetDefaultInterface: IFirstServer;
  147.     constructor Create(AServer: TFirstServer);
  148.   protected
  149.     function  Get_Value: Integer;
  150.     procedure Set_Value(Value: Integer);
  151.   public
  152.     property DefaultInterface: IFirstServer read GetDefaultInterface;
  153.   published
  154.     property Value: Integer read Get_Value write Set_Value;
  155.   end;
  156. {$ENDIF}
  157. procedure Register;
  158. resourcestring
  159.   dtlServerPage = 'ActiveX';
  160. implementation
  161. uses ComObj;
  162. class function CoFirstServer.Create: IFirstServer;
  163. begin
  164.   Result := CreateComObject(CLASS_FirstServer) as IFirstServer;
  165. end;
  166. class function CoFirstServer.CreateRemote(const MachineName: string): IFirstServer;
  167. begin
  168.   Result := CreateRemoteComObject(MachineName, CLASS_FirstServer) as IFirstServer;
  169. end;
  170. procedure TFirstServer.InitServerData;
  171. const
  172.   CServerData: TServerData = (
  173.     ClassID:   '{89855B43-8EFE-11D0-98D0-444553540000}';
  174.     IntfIID:   '{89855B42-8EFE-11D0-98D0-444553540000}';
  175.     EventIID:  '';
  176.     LicenseKey: nil;
  177.     Version: 500);
  178. begin
  179.   ServerData := @CServerData;
  180. end;
  181. procedure TFirstServer.Connect;
  182. var
  183.   punk: IUnknown;
  184. begin
  185.   if FIntf = nil then
  186.   begin
  187.     punk := GetServer;
  188.     Fintf:= punk as IFirstServer;
  189.   end;
  190. end;
  191. procedure TFirstServer.ConnectTo(svrIntf: IFirstServer);
  192. begin
  193.   Disconnect;
  194.   FIntf := svrIntf;
  195. end;
  196. procedure TFirstServer.DisConnect;
  197. begin
  198.   if Fintf <> nil then
  199.   begin
  200.     FIntf := nil;
  201.   end;
  202. end;
  203. function TFirstServer.GetDefaultInterface: IFirstServer;
  204. begin
  205.   if FIntf = nil then
  206.     Connect;
  207.   Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  208.   Result := FIntf;
  209. end;
  210. constructor TFirstServer.Create(AOwner: TComponent);
  211. begin
  212.   inherited Create(AOwner);
  213. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  214.   FProps := TFirstServerProperties.Create(Self);
  215. {$ENDIF}
  216. end;
  217. destructor TFirstServer.Destroy;
  218. begin
  219. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  220.   FProps.Free;
  221. {$ENDIF}
  222.   inherited Destroy;
  223. end;
  224. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  225. function TFirstServer.GetServerProperties: TFirstServerProperties;
  226. begin
  227.   Result := FProps;
  228. end;
  229. {$ENDIF}
  230. function  TFirstServer.Get_Value: Integer;
  231. begin
  232.   Result := DefaultInterface.Value;
  233. end;
  234. procedure TFirstServer.Set_Value(Value: Integer);
  235. begin
  236.   DefaultInterface.Value := Value;
  237. end;
  238. procedure TFirstServer.ChangeColor;
  239. begin
  240.   DefaultInterface.ChangeColor;
  241. end;
  242. {$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  243. constructor TFirstServerProperties.Create(AServer: TFirstServer);
  244. begin
  245.   inherited Create;
  246.   FServer := AServer;
  247. end;
  248. function TFirstServerProperties.GetDefaultInterface: IFirstServer;
  249. begin
  250.   Result := FServer.DefaultInterface;
  251. end;
  252. function  TFirstServerProperties.Get_Value: Integer;
  253. begin
  254.   Result := DefaultInterface.Value;
  255. end;
  256. procedure TFirstServerProperties.Set_Value(Value: Integer);
  257. begin
  258.   DefaultInterface.Value := Value;
  259. end;
  260. {$ENDIF}
  261. procedure Register;
  262. begin
  263.   RegisterComponents(dtlServerPage, [TFirstServer]);
  264. end;
  265. end.