git-svn-id: https://svn.code.sf.net/p/kolmck/code@161 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2017-05-13 15:07:19 +00:00
parent 6ab50db1d5
commit 9b54772921
5 changed files with 6 additions and 117 deletions

View File

@@ -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;

View File

@@ -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

View File

@@ -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;

View File

@@ -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 );

View File

@@ -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