Skip to content

Commit

Permalink
sync'd to latest versions
Browse files Browse the repository at this point in the history
  • Loading branch information
@gabr42
gabr42 committed Feb 9, 2017
1 parent 3ebc622 commit ada59a5
Show file tree
Hide file tree
Showing 2 changed files with 124 additions and 38 deletions.
37 changes: 20 additions & 17 deletions src/GpLists.pas
View file
Expand Up @@ -30,10 +30,13 @@
Author : Primoz Gabrijelcic
Creation date : 2002-07-04
Last modification : 2016-05-03
Version : 1.72
Last modification : 2016-08-30
Version : 1.72a
</pre>*)(*
History:
1.72a: 2016-08-30
- TGpInt64ObjectList<T> methods had 'item' incorrectly defined as 'integer'
instead of 'int64'.
1.72: 2016-05-03
- Implemented IGpInt64ObjectList<T> and TGpInt64ObjectList<T>.
1.71: 2016-03-05
Expand Down Expand Up @@ -1113,12 +1116,12 @@ TGpInt64ObjectList = class(TGpInt64List, IGpInt64ObjectList)
function GetObject(idxObject: integer): T;
procedure SetObject(idxObject: integer; const value: T);
//
function AddObject(item: integer; obj: T): integer;
function EnsureObject(item: integer): integer; overload;
function EnsureObject(item: integer; obj: T): integer; overload;
function AddObject(item: int64; obj: T): integer;
function EnsureObject(item: int64): integer; overload;
function EnsureObject(item: int64; obj: T): integer; overload;
function ExtractObject(idxObject: integer): T;
function FetchObject(item: integer): T;
procedure InsertObject(idx: integer; item: integer; obj: T);
function FetchObject(item: int64): T;
procedure InsertObject(idx: integer; item: int64; obj: T);
property Objects[idxObject: integer]: T read GetObject write SetObject;
end; { IGpInt64ObjectList<T> }

Expand All @@ -1131,12 +1134,12 @@ TGpInt64ObjectList<T: class, constructor> = class(TGpInt64ObjectList, IGpInt64
procedure SetObject(idxObject: integer; const value: T); reintroduce;
public
class function CreateInterface(ownsObjects: boolean = true): IGpInt64ObjectList<T>;
function AddObject(item: integer; obj: T): integer; reintroduce; inline;
function EnsureObject(item: integer): integer; overload; inline;
function EnsureObject(item: integer; obj: T): integer; reintroduce; overload; inline;
function AddObject(item: int64; obj: T): integer; reintroduce; inline;
function EnsureObject(item: int64): integer; overload; inline;
function EnsureObject(item: int64; obj: T): integer; reintroduce; overload; inline;
function ExtractObject(idxObject: integer): T; reintroduce; inline;
function FetchObject(item: integer): T; reintroduce; inline;
procedure InsertObject(idx: integer; item: integer; obj: T); reintroduce; inline;
function FetchObject(item: int64): T; reintroduce; inline;
procedure InsertObject(idx: integer; item: int64; obj: T); reintroduce; inline;
property Objects[idxObject: integer]: T read GetObject write SetObject;
end; { TGpInt64ObjectList<T> }
{$ENDIF GpLists_LimitedGenerics}
Expand Down Expand Up @@ -4525,17 +4528,17 @@ class function TGpInt64ObjectList<T>.CreateInterface(ownsObjects: boolean = true
Result := TGpInt64ObjectList<T>.Create(ownsObjects);
end; { TGpInt64ObjectList<T>.CreateInterface }

function TGpInt64ObjectList<T>.AddObject(item: integer; obj: T): integer;
function TGpInt64ObjectList<T>.AddObject(item: int64; obj: T): integer;
begin
Result := inherited AddObject(item, obj);
end; { TGpInt64ObjectList<T>.AddObject }

function TGpInt64ObjectList<T>.EnsureObject(item: integer; obj: T): integer;
function TGpInt64ObjectList<T>.EnsureObject(item: int64; obj: T): integer;
begin
Result := inherited EnsureObject(item, TObject(PPointer(@obj)^));
end; { TGpInt64ObjectList<T>.EnsureObject }

function TGpInt64ObjectList<T>.EnsureObject(item: integer): integer;
function TGpInt64ObjectList<T>.EnsureObject(item: int64): integer;
begin
Result := inherited EnsureObject(item, TClass(T));
end; { TGpInt64ObjectList<T>.EnsureObject }
Expand All @@ -4545,7 +4548,7 @@ function TGpInt64ObjectList<T>.ExtractObject(idxObject: integer): T;
Result := T(inherited ExtractObject(idxObject));
end; { TGpInt64ObjectList<T>.ExtractObject }

function TGpInt64ObjectList<T>.FetchObject(item: integer): T;
function TGpInt64ObjectList<T>.FetchObject(item: int64): T;
begin
Result := T(inherited FetchObject(item));
end; { TGpInt64ObjectList<T>.FetchObject }
Expand All @@ -4555,7 +4558,7 @@ function TGpInt64ObjectList<T>.GetObject(idxObject: integer): T;
Result := T(inherited GetObject(idxObject));
end; { TGpInt64ObjectList<T>.GetObject }

procedure TGpInt64ObjectList<T>.InsertObject(idx, item: integer; obj: T);
procedure TGpInt64ObjectList<T>.InsertObject(idx: integer; item: int64; obj: T);
begin
inherited InsertObject(idx, item, obj);
end; { TGpInt64ObjectList<T>.InsertObject }
Expand Down
125 changes: 104 additions & 21 deletions src/GpStuff.pas
View file
Expand Up @@ -6,10 +6,24 @@
Author : Primoz Gabrijelcic
Creation date : 2006-09-25
Last modification : 2016-03-29
Version : 1.57
Last modification : 2016-11-10
Version : 1.63
</pre>*)(*
History:
1.63: 2016-11-10
- Added StoreValue<T>.
1.62: 2016-09-07
- Implemented IGpBuffer.Append.
- Implemented IGpBuffer.SetSize.
1.61: 2016-07-27
- Added type TCFunc<T1,T2,TResult>.
1.60: 2016-07-21
- Added IndexOfList.
1.59: 2016-07-18
- Defined anonymous record TRec<T1,T2,T3,T4,T5>.
1.58: 2016-06-30
- TGpTraceable no longer descends from TInterfacedObject and implements
refcounting internally.
1.57: 2016-03-29
- Added type TCFunc.
- Added two EnumList overloads acception filter with signature (const string): string.
Expand Down Expand Up @@ -290,15 +304,17 @@ TGpInterfacedPersistent = class(TPersistent, IInterface)
property TraceReferences: boolean read GetTraceReferences write SetTraceReferences;
end; { IGpTraceable }

TGpTraceable = class(TInterfacedObject, IGpTraceable)
TGpTraceable = class(TObject, IGpTraceable)
private
gtLogRef : boolean;
gtRefCount: TGp4AlignedInt;
gtTraceRef: boolean;
protected
function GetLogReferences: boolean; stdcall;
function GetTraceReferences: boolean; stdcall;
procedure SetLogReferences(const value: boolean); stdcall;
procedure SetTraceReferences(const value: boolean); stdcall;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
public
destructor Destroy; override;
function _AddRef: integer; stdcall;
Expand Down Expand Up @@ -341,22 +357,24 @@ TGpMemoryBuffer = class
function GetAsString: string;
function GetByteVal(idx: integer): byte;
function GetSize: integer;
function GetValue: pointer;
procedure SetAsAnsiString(const value: AnsiString);
procedure SetAsString(const value: string);
procedure SetByteVal(idx: integer; const value: byte);
function GetValue: pointer;
procedure SetSize(const value: integer);
//
procedure Add(b: byte); overload;
procedure Add(ch: AnsiChar); overload;
procedure Allocate(size: integer);
procedure Append(data: pointer; size: integer);
procedure Assign(data: pointer; size: integer);
procedure Clear;
function IsEmpty: boolean;
property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
property AsStream: TStream read GetAsStream;
property AsString: string read GetAsString write SetAsString;
property ByteVal[idx: integer]: byte read GetByteVal write SetByteVal; default;
property Size: integer read GetSize;
property Size: integer read GetSize write SetSize;
property Value: pointer read GetValue;
end; { IGpBuffer }

Expand All @@ -373,6 +391,7 @@ TGpBuffer = class(TInterfacedObject, IGpBuffer)
procedure SetAsAnsiString(const value: AnsiString); inline;
procedure SetAsString(const value: string); inline;
procedure SetByteVal(idx: integer; const value: byte); inline;
procedure SetSize(const value: integer); inline;
public
constructor Create; overload;
constructor Create(data: pointer; size: integer); overload;
Expand All @@ -381,14 +400,15 @@ TGpBuffer = class(TInterfacedObject, IGpBuffer)
procedure Add(b: byte); overload; inline;
procedure Add(ch: AnsiChar); overload; inline;
procedure Allocate(size: integer); inline;
procedure Append(data: pointer; size: integer); inline;
procedure Assign(data: pointer; size: integer); inline;
procedure Clear; inline;
function IsEmpty: boolean; inline;
property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
property AsStream: TStream read GetAsStream;
property AsString: string read GetAsString write SetAsString;
property ByteVal[idx: integer]: byte read GetByteVal write SetByteVal; default;
property Size: integer read GetSize;
property Size: integer read GetSize write SetSize;
property Value: pointer read GetValue;
end; { TGpBuffer }

Expand Down Expand Up @@ -441,6 +461,15 @@ TRec<T1,T2,T3,T4> = record
Field4: T4;
constructor Create(Value1: T1; Value2: T2; Value3: T3; Value4: T4);
end;

TRec<T1,T2,T3,T4,T5> = record
Field1: T1;
Field2: T2;
Field3: T3;
Field4: T4;
Field5: T5;
constructor Create(Value1: T1; Value2: T2; Value3: T3; Value4: T4; Value5: T5);
end;
{$ENDIF GpStuff_Generics}

function OffsetPtr(ptr: pointer; offset: integer): pointer; {$IFDEF GpStuff_Inline}inline;{$ENDIF}
Expand Down Expand Up @@ -539,6 +568,7 @@ TGpStringPair = class

{$IFDEF GpStuff_FullAnonymous}
TCFunc<T,TResult> = reference to function (const Arg1: T): TResult;
TCFunc<T1,T2,TResult> = reference to function (const Arg1: T1; const Arg2: T2): TResult;
{$ENDIF}

function EnumValues(const aValues: array of integer): IGpIntegerValueEnumeratorFactory;
Expand All @@ -562,6 +592,7 @@ function EnumFiles(const fileMask: string; attr: integer; returnFullPath: boolea

function AddToList(const aList, delim, newElement: string): string;
function IsInList(const value: string; const values: array of string; caseSensitive: boolean = false): boolean;
function IndexOfList(const value: string; const values: array of string; caseSensitive: boolean = false): integer;

{$IFDEF GpStuff_TArrayOfT}
function SplitList(const aList: string; delim: char; const quoteChar: string = '';
Expand Down Expand Up @@ -598,6 +629,18 @@ function BuildString: IGpStringBuilder;

function GetRefCount(const intf: IInterface): integer;

{$IFDEF GpStuff_Generics}
type
TStoredValue<T> = record
public
StoredValue: T;
end;

StoreValue<T> = class
class function Create(const value: T): TStoredValue<T>; static;
end;
{$ENDIF GpStuff_Generics}

implementation

uses
Expand Down Expand Up @@ -1672,19 +1715,25 @@ function EnumFiles(const fileMask: string; attr: integer; returnFullPath: boolea
end; { EnumFiles }

function IsInList(const value: string; const values: array of string; caseSensitive: boolean): boolean;
begin
Result := (IndexOfList(value, values, caseSensitive) >= 0);
end; { IsInList }

function IndexOfList(const value: string; const values: array of string; caseSensitive: boolean = false): integer;
var
s: string;
begin
Result := true;
for s in EnumStrings(values) do
for Result := Low(values) to High(values) do begin
s := values[Result];
if caseSensitive then begin
if SameStr(value, s) then
Exit;
end
else if SameText(value, s) then
Exit;
Result := false;
end; { IsInList }
end;
Result := -1;
end; { IndexOfList }
{$ENDIF GpStuff_ValuesEnumerators}

function AddToList(const aList, delim, newElement: string): string;
Expand Down Expand Up @@ -1770,14 +1819,22 @@ function TGpTraceable.GetLogReferences: boolean;

function TGpTraceable.GetRefCount: integer;
begin
Result := RefCount;
Result := gtRefCount.Value;
end; { TGpTraceable.GetRefCount }

function TGpTraceable.GetTraceReferences: boolean;
begin
Result := gtTraceRef;
end; { TGpTraceable.GetTraceReferences }

function TGpTraceable.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end; { TGpTraceable.QueryInterface }

procedure TGpTraceable.SetLogReferences(const value: boolean);
begin
gtLogRef := value;
Expand All @@ -1790,21 +1847,20 @@ procedure TGpTraceable.SetTraceReferences(const value: boolean);

function TGpTraceable._AddRef: integer;
begin
Result := inherited _AddRef;
Result := gtRefCount.Increment;
if gtLogRef then
OutputDebugString(PChar(Format('TGpTraceable._AddRef: [%s] %d', [ClassName, Result])));
DebugBreak(gtTraceRef);
end; { TGpTraceable._AddRef }

function TGpTraceable._Release: integer;
var
sClassName: string;
begin
sClassName := ClassName;
DebugBreak(gtTraceRef);
Result := inherited _Release;
Result := gtRefCount.Decrement;
if gtLogRef then
OutputDebugString(PChar(Format('TGpTraceable._Release: [%s] %d', [sClassName, Result])));
OutputDebugString(PChar(Format('TGpTraceable._Release: [%s] %d', [ClassName, Result])));
if Result = 0 then
Destroy;
end; { TGpTraceable._Release }

{$IFDEF GpStuff_ValuesEnumerators}
Expand Down Expand Up @@ -2061,6 +2117,11 @@ procedure TGpBuffer.Allocate(size: integer);
FData.Size := size;
end; { TGpBuffer.Allocate }

procedure TGpBuffer.Append(data: pointer; size: integer);
begin
FData.Write(data^, size);
end; { TGpBuffer.Append }

procedure TGpBuffer.Assign(data: pointer; size: integer);
begin
Allocate(size);
Expand Down Expand Up @@ -2135,6 +2196,11 @@ procedure TGpBuffer.SetByteVal(idx: integer; const value: byte);
PByte(NativeUInt(Value) + NativeUInt(idx))^ := value;
end; { TGpBuffer.SetByteVal }

procedure TGpBuffer.SetSize(const value: integer);
begin
FData.Size := value;
end; { TGpBuffer.SetSize }

{ TGpInterfacedPersistent }

procedure TGpInterfacedPersistent.AfterConstruction;
Expand Down Expand Up @@ -2181,28 +2247,45 @@ class function Ternary<T>.IFF(condit: boolean; iftrue, iffalse: T): T;
Result := iftrue
else
Result := iffalse;
end;
end; { Ternary<T>.IFF }

constructor TRec<T1, T2>.Create(Value1: T1; Value2: T2);
begin
Field1 := Value1;
Field2 := Value2;
end;
end; { TRec<T1, T2>.Create }

constructor TRec<T1, T2, T3>.Create(Value1: T1; Value2: T2; Value3: T3);
begin
Field1 := Value1;
Field2 := Value2;
Field3 := Value3;
end;
end; { TRec<T1, T2, T3>.Create }

constructor TRec<T1, T2, T3, T4>.Create(Value1: T1; Value2: T2; Value3: T3; Value4: T4);
begin
Field1 := Value1;
Field2 := Value2;
Field3 := Value3;
Field4 := Value4;
end;
end; { TRec<T1, T2, T3, T4>.Create }

constructor TRec<T1, T2, T3, T4, T5>.Create(Value1: T1; Value2: T2; Value3: T3;
Value4: T4; Value5: T5);
begin
Field1 := Value1;
Field2 := Value2;
Field3 := Value3;
Field4 := Value4;
Field5 := Value5;
end; { TRec<T1, T2, T3, T4, T5>.Create }

{ StoreValue<T> }

class function StoreValue<T>.Create(const value: T): TStoredValue<T>;
begin
Result.StoredValue := value;
end; { StoreValue<T>.Create }
{$ENDIF GpStuff_Generics}

end.

0 comments on commit ada59a5

Please sign in to comment.