paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ Compiles on win32 also now

Browse Source
This commit is contained in:
michael 2000-08-29 17:35:55 +00:00
parent 858bff5bda
commit 61192ad683
3 changed files with 44 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
rtl/objpas/varutils.inc
View File

@ -20,43 +20,6 @@
---------------------------------------------------------------------}
Resourcestring
SNoWidestrings = 'No widestrings supported';
SNoInterfaces = 'No interfaces supported';
Procedure NoWidestrings;
begin
Raise Exception.Create(SNoWideStrings);
end;
Procedure NoInterfaces;
begin
Raise Exception.Create(SNoInterfaces);
end;
Constructor EVariantError.CreateCode (Code : longint);
begin
ErrCode:=Code;
end;
Procedure VariantTypeMismatch;
begin
Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
end;
Function ExceptionToVariantError (E : Exception): HResult;
begin
If E is EoutOfMemory then
Result:=VAR_OUTOFMEMORY
else
Result:=VAR_EXCEPTION;
end;
Procedure SetUnlockResult (P : PVarArray; Res : HResult);

39
rtl/objpas/varutils.pp
View File

@ -165,6 +165,45 @@ const
Implementation
Resourcestring
SNoWidestrings = 'No widestrings supported';
SNoInterfaces = 'No interfaces supported';
Procedure NoWidestrings;
begin
Raise Exception.Create(SNoWideStrings);
end;
Procedure NoInterfaces;
begin
Raise Exception.Create(SNoInterfaces);
end;
Constructor EVariantError.CreateCode (Code : longint);
begin
ErrCode:=Code;
end;
Procedure VariantTypeMismatch;
begin
Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);
end;
Function ExceptionToVariantError (E : Exception): HResult;
begin
If E is EoutOfMemory then
Result:=VAR_OUTOFMEMORY
else
Result:=VAR_EXCEPTION;
end;
{$i varutils.inc}
{ ---------------------------------------------------------------------

7
rtl/win32/varutils.inc
View File

@ -30,7 +30,7 @@ function VariantInit(var Varg: TVarData): HRESULT; stdcall;external oleaut;
{ Variant array functions }
function SafeArrayAccessData(psa: PVarArray; var Data: Pointer): HRESULT; stdcall;external oleaut;
function SafeArrayAccessData(psa: PVarArray; var ppvData: Pointer): HRESULT; stdcall;external oleaut;
function SafeArrayAllocData(psa: PVarArray): HRESULT; stdcall;external oleaut;
function SafeArrayAllocDescriptor(DimCount: Integer; var psa: PVarArray): HRESULT; stdcall;external oleaut;
function SafeArrayCopy(psa: PVarArray; var psaOut: PVarArray): HRESULT; stdcall;external oleaut;
@ -53,7 +53,10 @@ function SafeArrayUnlock(psa: PVarArray): HRESULT; stdcall;external oleaut;
{
$Log$
Revision 1.1 2000-08-29 08:23:14 michael
Revision 1.2 2000-08-29 17:35:55 michael
+ Compiles on win32 also now
Revision 1.1 2000/08/29 08:23:14 michael
+ Initial implementation of varutils
}