mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-31 22:10:55 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			54 lines
		
	
	
		
			1.7 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			54 lines
		
	
	
		
			1.7 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| { compiletime ComObj support }
 | |
| unit uPSC_comobj;
 | |
| 
 | |
| {$I PascalScript.inc}
 | |
| interface
 | |
| uses
 | |
|   uPSCompiler, uPSUtils;
 | |
| 
 | |
| {
 | |
|  
 | |
| Will register:
 | |
|  
 | |
| function CreateOleObject(const ClassName: String): IDispatch;
 | |
| function GetActiveOleObject(const ClassName: String): IDispatch;
 | |
| 
 | |
| }
 | |
| 
 | |
| procedure SIRegister_ComObj(cl: TPSPascalCompiler);
 | |
| 
 | |
| implementation
 | |
| 
 | |
| procedure SIRegister_ComObj(cl: TPSPascalCompiler);
 | |
| begin
 | |
| {$IFDEF FPC}
 | |
|     {$IFDEF PS_FPC_HAS_COM}
 | |
|     cl.AddTypeS('HResult', 'LongInt');
 | |
|     cl.AddTypeS('TGUID', 'record D1: LongWord; D2: Word; D3: Word; D4: array[0..7] of Byte; end;');
 | |
|     cl.AddTypeS('TCLSID', 'TGUID');
 | |
|     cl.AddTypeS('TIID', 'TGUID');
 | |
|     cl.AddDelphiFunction('procedure OleCheck(Result: HResult);');
 | |
|     cl.AddDelphiFunction('function StringToGUID(const S: string): TGUID;');
 | |
|     cl.AddDelphiFunction('function CreateComObject(const ClassID: TGUID): IUnknown;');
 | |
|     cl.AddDelphiFunction('function CreateOleObject(const ClassName: String): IDispatch;');
 | |
|     cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: String): IDispatch;');
 | |
|     {$ENDIF}
 | |
| {$ELSE}
 | |
|   cl.AddTypeS('HResult', 'LongInt');
 | |
|   cl.AddTypeS('TGUID', 'record D1: LongWord; D2: Word; D3: Word; D4: array[0..7] of Byte; end;');
 | |
|   cl.AddTypeS('TCLSID', 'TGUID');
 | |
|   cl.AddTypeS('TIID', 'TGUID');
 | |
|   cl.AddDelphiFunction('procedure OleCheck(Result: HResult);');
 | |
| {$IFNDEF PS_NOINTERFACES}
 | |
| {$IFDEF DELPHI3UP}
 | |
|   cl.AddDelphiFunction('function StringToGUID(const S: string): TGUID;');
 | |
|   cl.AddDelphiFunction('function CreateComObject(const ClassID: TGUID): IUnknown;');
 | |
| {$ENDIF}
 | |
| {$ENDIF}
 | |
|   cl.AddDelphiFunction('function CreateOleObject(const ClassName: String): IDispatch;');
 | |
|   cl.AddDelphiFunction('function GetActiveOleObject(const ClassName: String): IDispatch;');
 | |
| {$ENDIF}  
 | |
| end;
 | |
| 
 | |
| end.
 | 
