* fix
git-svn-id: https://svn.code.sf.net/p/kolmck/code@161 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
@@ -18,11 +18,6 @@ uses
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF _D5orHigher}
|
||||
const
|
||||
sNoRunningObject = 'Unable to retrieve a pointer to a running object registered with OLE for %s/%s';
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
POleCtl = ^TOleCtl;
|
||||
|
||||
@@ -46,11 +41,6 @@ type
|
||||
constructor Create(Control: POleCtl);
|
||||
end;
|
||||
|
||||
{$IFNDEF _D5orHigher}
|
||||
TOleEnum = type Integer;
|
||||
//{$NODEFINE TOleEnum}
|
||||
{$ENDIF}
|
||||
|
||||
TGetStrProc = procedure(const S: string) of object;
|
||||
|
||||
TEnumValue = record
|
||||
@@ -354,7 +344,6 @@ type
|
||||
|
||||
end;
|
||||
|
||||
{$IFNDEF _D2orD3}
|
||||
type
|
||||
TVariantArray = Array of OleVariant;
|
||||
TOleServer = class;
|
||||
@@ -446,7 +435,6 @@ type
|
||||
property ConnectKind: TConnectKind read GetConnectKind write SetConnectKind;
|
||||
property RemoteMachineName: string read FRemoteMachineName write FRemoteMachineName;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
EmptyParam: OleVariant; { "Empty parameter" standard constant which can be
|
||||
@@ -1911,7 +1899,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFNDEF _D2orD3}
|
||||
{ TServerEventDispatch }
|
||||
constructor TServerEventDispatch.Create(Server: TOleServer);
|
||||
begin
|
||||
@@ -2130,7 +2117,6 @@ begin
|
||||
Dec(FRefCount);
|
||||
Result := FRefCount;
|
||||
end;
|
||||
{$ENDIF _D2orD3}
|
||||
|
||||
{ TEventDispatch }
|
||||
|
||||
@@ -2202,22 +2188,14 @@ end;
|
||||
|
||||
function TOleCtlIntf._AddRef: Integer;
|
||||
begin
|
||||
//{$IFDEF _D2orD3}
|
||||
//Result := inherited _AddRef;
|
||||
//{$ELSE}
|
||||
Inc(FRefCount);
|
||||
Result := FRefCount;
|
||||
//{$ENDIF}
|
||||
end;
|
||||
|
||||
function TOleCtlIntf._Release: Integer;
|
||||
begin
|
||||
//{$IFDEF _D2orD3}
|
||||
//Result := inherited _Release;
|
||||
//{$ELSE}
|
||||
Dec(FRefCount);
|
||||
Result := FRefCount;
|
||||
//{$ENDIF}
|
||||
end;
|
||||
|
||||
function TOleCtlIntf.CanInPlaceActivate: HResult;
|
||||
|
@@ -54,7 +54,6 @@ type
|
||||
Reading is allowed while owning a write lock.
|
||||
Read locks can be promoted to write locks.}
|
||||
|
||||
{$IFNDEF _D2orD3}
|
||||
TActiveThreadRecord = record
|
||||
ThreadID: Integer;
|
||||
RecursionCount: Integer;
|
||||
@@ -80,7 +79,6 @@ type
|
||||
procedure BeginWrite;
|
||||
procedure EndWrite;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ COM class manager }
|
||||
|
||||
@@ -89,9 +87,7 @@ type
|
||||
TComClassManager = class(TObject)
|
||||
private
|
||||
FFactoryList: TComObjectFactory;
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock: TMultiReadExclusiveWriteSynchronizer;
|
||||
{$ENDIF}
|
||||
procedure AddObjectFactory(Factory: TComObjectFactory);
|
||||
procedure RemoveObjectFactory(Factory: TComObjectFactory);
|
||||
public
|
||||
@@ -600,7 +596,6 @@ begin
|
||||
Result := S_OK;
|
||||
end;
|
||||
|
||||
{$IFNDEF _D2orD3}
|
||||
{ TMultiReadExclusiveWriteSynchronizer }
|
||||
|
||||
constructor TMultiReadExclusiveWriteSynchronizer.Create;
|
||||
@@ -766,38 +761,29 @@ begin
|
||||
TObject(Obj) := nil; // clear the reference before destroying the object
|
||||
P.Free;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ TComClassManager }
|
||||
constructor TComClassManager.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock := TMultiReadExclusiveWriteSynchronizer.Create;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
destructor TComClassManager.Destroy;
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.Free;
|
||||
{$ENDIF}
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TComClassManager.AddObjectFactory(Factory: TComObjectFactory);
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.BeginWrite;
|
||||
try
|
||||
{$ENDIF}
|
||||
Factory.FNext := FFactoryList;
|
||||
FFactoryList := Factory;
|
||||
{$IFNDEF _D2orD3}
|
||||
finally
|
||||
FLock.EndWrite;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
|
||||
@@ -805,10 +791,8 @@ procedure TComClassManager.ForEachFactory(ComServer: TComServerObject;
|
||||
var
|
||||
Factory, Next: TComObjectFactory;
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.BeginWrite; // FactoryProc could add or delete factories from list
|
||||
try
|
||||
{$ENDIF}
|
||||
Factory := FFactoryList;
|
||||
while Factory <> nil do
|
||||
begin
|
||||
@@ -816,19 +800,15 @@ begin
|
||||
if Factory.ComServer = ComServer then FactoryProc(Factory);
|
||||
Factory := Next;
|
||||
end;
|
||||
{$IFNDEF _D2orD3}
|
||||
finally
|
||||
FLock.EndWrite;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TComClassManager.GetFactoryFromClass(ComClass: TClass): TComObjectFactory;
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.BeginRead;
|
||||
try
|
||||
{$ENDIF}
|
||||
Result := FFactoryList;
|
||||
while Result <> nil do
|
||||
begin
|
||||
@@ -836,40 +816,32 @@ begin
|
||||
Result := Result.FNext;
|
||||
end;
|
||||
raise EOleError.CreateResFmt(e_Ole, Integer( @SObjectFactoryMissing ), [ComClass.ClassName]);
|
||||
{$IFNDEF _D2orD3}
|
||||
finally
|
||||
FLock.EndRead;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TComClassManager.GetFactoryFromClassID(const ClassID: TGUID): TComObjectFactory;
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.BeginRead;
|
||||
try
|
||||
{$ENDIF}
|
||||
Result := FFactoryList;
|
||||
while Result <> nil do
|
||||
begin
|
||||
if IsEqualGUID(Result.ClassID, ClassID) then Exit;
|
||||
Result := Result.FNext;
|
||||
end;
|
||||
{$IFNDEF _D2orD3}
|
||||
finally
|
||||
FLock.EndRead;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TComClassManager.RemoveObjectFactory(Factory: TComObjectFactory);
|
||||
var
|
||||
F, P: TComObjectFactory;
|
||||
begin
|
||||
{$IFNDEF _D2orD3}
|
||||
FLock.BeginWrite;
|
||||
try
|
||||
{$ENDIF}
|
||||
P := nil;
|
||||
F := FFactoryList;
|
||||
while F <> nil do
|
||||
@@ -882,11 +854,9 @@ begin
|
||||
P := F;
|
||||
F := F.FNext;
|
||||
end;
|
||||
{$IFNDEF _D2orD3}
|
||||
finally
|
||||
FLock.EndWrite;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{ TComObject }
|
||||
@@ -1741,11 +1711,7 @@ var
|
||||
Handle: THandle;
|
||||
RegProc: TRegProc;
|
||||
begin
|
||||
{$IFDEF _D2orD3}
|
||||
Handle := LoadLibrary( PChar( DLLName ) );
|
||||
{$ELSE}
|
||||
Handle := SafeLoadLibrary(DLLName);
|
||||
{$ENDIF}
|
||||
if Handle <= HINSTANCE_ERROR then
|
||||
raise Exception.CreateFmt( e_Com, '%s: %s', [SysErrorMessage(GetLastError), DLLName]);
|
||||
try
|
||||
|
@@ -588,7 +588,7 @@ begin
|
||||
|
||||
// for listview
|
||||
if (fInPlaceEd.SubClassName = 'obj_SysListView32') then
|
||||
R.Bottom := R.Bottom + (R.Bottom - R.Top) * 4;
|
||||
R.Bottom := R.Bottom + (R.Bottom - R.Top) * 7;
|
||||
|
||||
// set rect
|
||||
fInPlaceEd.BoundsRect := R;
|
||||
|
@@ -939,38 +939,6 @@ begin
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
(*
|
||||
function Data2Hex(Data: Pointer; Count: integer): Pointer;
|
||||
function HexDigit( B : Byte ) : Char;
|
||||
{$IFDEF F_P}
|
||||
const
|
||||
HexDigitChr: array[ 0..15 ] of Char = ( '0','1','2','3','4','5','6','7',
|
||||
'8','9','A','B','C','D','E','F' );
|
||||
begin
|
||||
Result := HexDigitChr[ B and $F ];
|
||||
end;
|
||||
{$ELSE DELPHI}
|
||||
asm
|
||||
DB $3C,9
|
||||
JA @@1
|
||||
DB $04, $30-$41+$0A
|
||||
@@1:
|
||||
DB $04, $41-$0A
|
||||
end;
|
||||
{$ENDIF F_P/DELPHI}
|
||||
|
||||
var i: integer;
|
||||
ch: byte;
|
||||
begin
|
||||
GetMem(Result, Count*2);
|
||||
for i := 0 to Count-1 do begin
|
||||
ch := Byte(PChar(Data)[i]);
|
||||
PChar(Result)[i*2] := HexDigit( ch and $F );
|
||||
ch := ch shr 4;
|
||||
PChar(Result)[i*2+1] := HexDigit( ch and $F );
|
||||
end;
|
||||
end; *)
|
||||
|
||||
function AlignColorTo16Bit;
|
||||
begin
|
||||
Color := Color2RGB( Color );
|
||||
|
@@ -180,61 +180,44 @@ procedure SumsAndSquares(const Data: array of Double;
|
||||
function MinValue(const Data: array of Double): Double;
|
||||
function MinIntValue(const Data: array of Integer): Integer;
|
||||
|
||||
function Min(A,B: Integer): Integer;
|
||||
{$IFDEF _D4orHigher}
|
||||
overload;
|
||||
function Min(A,B: Integer): Integer; overload;
|
||||
function Min(A,B: I64): I64; overload;
|
||||
function Min(A,B: Int64): Int64; overload;
|
||||
function Min(A,B: Single): Single; overload;
|
||||
function Min(A,B: Double): Double; overload;
|
||||
function Min(A,B: Extended): Extended; overload;
|
||||
{$ENDIF}
|
||||
|
||||
{ MaxValue: Returns the largest signed value in the data array (MAX) }
|
||||
function MaxValue(const Data: array of Double): Double;
|
||||
function MaxIntValue(const Data: array of Integer): Integer;
|
||||
|
||||
function Max(A,B: Integer): Integer;
|
||||
{$IFDEF _D4orHigher}
|
||||
overload;
|
||||
function Max(A,B: Integer): Integer; overload;
|
||||
function Max(A,B: I64): I64; overload;
|
||||
function Max(A,B: Single): Single; overload;
|
||||
function Max(A,B: Double): Double; overload;
|
||||
function Max(A,B: Extended): Extended; overload;
|
||||
{$ENDIF}
|
||||
|
||||
{ Standard Deviation (STD): Sqrt(Variance). aka Sample Standard Deviation }
|
||||
function StdDev(const Data: array of Double): Extended;
|
||||
|
||||
{ MeanAndStdDev calculates Mean and StdDev in one call. }
|
||||
procedure MeanAndStdDev(const Data: array of Double; var Mean, StdDev: Extended);
|
||||
|
||||
{ Population Standard Deviation (STDP): Sqrt(PopnVariance).
|
||||
Used in some business and financial calculations. }
|
||||
{ Population Standard Deviation (STDP): Sqrt(PopnVariance). Used in some business and financial calculations. }
|
||||
function PopnStdDev(const Data: array of Double): Extended;
|
||||
|
||||
{ Variance (VARS): TotalVariance / (N-1). aka Sample Variance }
|
||||
function Variance(const Data: array of Double): Extended;
|
||||
|
||||
{ Population Variance (VAR or VARP): TotalVariance/ N }
|
||||
function PopnVariance(const Data: array of Double): Extended;
|
||||
|
||||
{ Total Variance: SUM(i=1,N)[(X(i) - Mean)**2] }
|
||||
function TotalVariance(const Data: array of Double): Extended;
|
||||
|
||||
{ Norm: The Euclidean L2-norm. Sqrt(SumOfSquares) }
|
||||
function Norm(const Data: array of Double): Extended;
|
||||
|
||||
{ MomentSkewKurtosis: Calculates the core factors of statistical analysis:
|
||||
the first four moments plus the coefficients of skewness and kurtosis.
|
||||
M1 is the Mean. M2 is the Variance.
|
||||
Skew reflects symmetry of distribution: M3 / (M2**(3/2))
|
||||
Kurtosis reflects flatness of distribution: M4 / Sqr(M2) }
|
||||
procedure MomentSkewKurtosis(const Data: array of Double;
|
||||
var M1, M2, M3, M4, Skew, Kurtosis: Extended);
|
||||
|
||||
{ RandG produces random numbers with Gaussian distribution about the mean.
|
||||
Useful for simulating data with sampling errors. }
|
||||
procedure MomentSkewKurtosis(const Data: array of Double; var M1, M2, M3, M4, Skew, Kurtosis: Extended);
|
||||
{ RandG produces random numbers with Gaussian distribution about the mean. Useful for simulating data with sampling errors. }
|
||||
function RandG(Mean, StdDev: Extended): Extended;
|
||||
|
||||
{-----------------------------------------------------------------------
|
||||
@@ -323,9 +306,7 @@ function count_1_bits_in_dword( x: Integer ): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFNDEF _D2orD3}
|
||||
uses SysConst;
|
||||
{$ENDIF}
|
||||
|
||||
function EAbs( D: Double ): Double;
|
||||
begin
|
||||
@@ -959,7 +940,6 @@ begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF _D4orHigher}
|
||||
function Min(A,B: I64): I64;
|
||||
begin
|
||||
if Cmp64( A, B ) < 0 then
|
||||
@@ -999,7 +979,6 @@ begin
|
||||
else
|
||||
Result := B;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function MaxValue(const Data: array of Double): Double;
|
||||
var
|
||||
@@ -1039,7 +1018,6 @@ begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF _D4orHigher}
|
||||
function Max(A,B: I64): I64;
|
||||
begin
|
||||
if Cmp64( A, B ) > 0 then
|
||||
@@ -1071,7 +1049,6 @@ begin
|
||||
else
|
||||
Result := B;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure MeanAndStdDev(const Data: array of Double; var Mean, StdDev: Extended);
|
||||
var
|
||||
|
Reference in New Issue
Block a user