The SDL Component Suite is an industry leading collection of components supporting scientific and engineering computing. Please visit the SDL Web site for more information....



Interface of SDL_DStruct


const
  SABuffSize = 32768;                                  { size of string buffer }
{$IFDEF PAIDVERS}
  SDLVersionInfo = 'dstruct_r1200_full';
  IsLightEd = false;
{$ELSE}
  SDLVersionInfo = 'dstruct_r1200_lighted';
  IsLightEd = true;
{$ENDIF}
  Release = 1200;

type
  ESDLDStructError = class(ESDLError);     { exception type to indicate errors }
  TLogicOp = (loAND, loOR, loXOR, loANDNot, loORNot, loXORNot);
  TCombination  = array[0..255] of byte;
  TCRC16Mode = (crcZModem, crcCCITT);
  TBeforeSortExchgEvent = procedure (Sender: TObject; InString: string;
  		     var OutString: string) of object;

  TSHACode = array [0..19] of Byte;             { hash code of SHA-1 algorithm }

  TBitFld = class(TComponent)
            private
              FSize     : longint;                         { size of bit field }
              FBitArray : array of byte;                           { bit field }
              procedure SetSize (s: longint);
              procedure SetBit (ix: longint; value: boolean);
              function  GetBit (ix: longint): boolean;
              procedure SetRandBitsIntern (NBits: integer);
            protected
              procedure AssignTo (Dest: TPersistent); override;
            public
              constructor Create (AOwner: TComponent); override;
              destructor  Destroy; override;
              procedure Assign(Source: TPersistent); override;
              procedure Clear;
              procedure Clone (Source: TBitFld);
              function  CountTrueBits: longint;
              function  FirstTrueBit: longint;
              procedure MakeListOfBits (var BitList: TIntArray; State: boolean);
              procedure ToggleBit (ix: longint);
              procedure CombineWith (SecondBArray: TBitFld; Operation: TLogicOp);
              function  Hash: TSHACode;
              procedure Invert;
              procedure RandomFill (Percent: double); overload;
              procedure RandomFill (NBits: integer); overload;
              function  SelectRandomBit (PreCondition: boolean): integer;
              property  Bit[ix: longint]: boolean
                           read GetBit write SetBit; default;
            published
              property  Size: longint read FSize write SetSize;
            end;

  TStringAccu = class(TComponent)
            private
              FSize     : longint;                       { size of string list }
              FStrArray : array of string;                       { string list }
              FCntArray : array of integer;                 { count of strings }
              function  GetString (ix: longint): string;
              function  GetCount (ix: longint): integer;
            public
              constructor Create (AOwner: TComponent); override;
              destructor  Destroy; override;
              procedure Clear;
              procedure Add (AString: string);
              property  Count[ix: integer]: integer read GetCount;
              property  Elem[ix: integer]: string read GetString; default;
              property  Size: longint read FSize;
            published
              //
            end;

  TByteMatrix = class(TComponent)
            private
              FNrCols    : integer;
              FNrRows    : integer;
              FByteMat   : array of array of byte;
              FOnChange  : TNotifyEvent;
              FDefaultVal: byte;
              function  GetBit (ix, iy, ixBit: longint): boolean;
              function  GetByte (ix, iy: longint): byte;
              procedure SetNrRows (nr: longint);
              procedure SetNrCols (nc: longint);
              procedure SetBit (ix, iy, ixBit: integer; value: boolean);
              procedure SetByte (ix, iy: integer; value: byte);
            protected
              procedure   AssignTo (Dest: TPersistent); override;
            public
              constructor Create (AOwner: TComponent); override;
              destructor Destroy; override;
              procedure Assign(Source: TPersistent); override;
              procedure Changed;
              procedure Fill (value: byte);
              function Resize (NrColumns, NrRows: integer): boolean;
              procedure ToggleBit (col, row, ixBit: integer);
              procedure MirrorColumns;
              procedure MirrorRows;
              procedure CombineWith (SecondByteMatrix: TByteMatrix;
                                     Operation: TLogicOp);
              property Bit[col,row,BitIx: integer]: boolean
                          read GetBit write SetBit;
              property Byte[col,row:integer]: byte
                          read GetByte write SetByte; default;
            published
              property DefaultValue: byte read FDefaultVal write FDefaultVal;
              property NrOfRows: integer read FNrRows write SetNrRows;
              property NrOfColumns: integer read FNrCols write SetNrCols;
              property OnChange: TNotifyEvent read FOnChange write FOnChange;
            end;

  T2DArrayStack = class(TComponent)
      private
        FStackSize     : integer;
        FData          : array of array of array of double;  // stack data
        FNames         : array of string;
        FStackPoi      : integer;
        procedure SetStackSize (Size: integer);
        function GetNumEntries: integer;
        function GetArrayName (idx: integer): string;
        procedure SetArrayName (idx: integer; value: string);
      public
        constructor Create (AOwner: TComponent);
        destructor Destroy;
        property ArrayName [ix: integer]: string
            read GetArrayName write SetArrayName;
        procedure Clear;
        function CloneArray (ix: integer; var Arr: TDouble2DArray): integer;
        function FindByName (Name: string): integer;
        property NumEntries: integer read GetNumEntries;
        function Pop (var Arr: TDouble2DArray): integer; overload;
        function Pop (var Arr: TDouble2DArray;
                      var Name: string): integer; overload;
        function Push (Arr: TDouble2DArray): integer; overload;
        function Push (Arr: TDouble2DArray; Name: string): integer; overload;
      published
        property MaxSize: integer read FStackSize write SetStackSize;
      end;

  TStringStack = class(TComponent)
      private
        FStackSize     : integer;
        FStrings       : array of string;
        FStackPoi      : integer;
        procedure SetStackSize (Size: integer);
        function GetNumEntries: integer;
      public
        constructor Create (AOwner: TComponent);
        destructor Destroy;
        procedure Clear;
        function CloneString (ix: integer; var Str: string): integer;
        function FindString (Str: string; SubString, IgnoreCase: boolean): integer;
        property NumEntries: integer read GetNumEntries;
        function Pop (var Str: string): integer;
        function Push (Str: string): integer;
      published
        property MaxSize: integer read FStackSize write SetStackSize;
      end;

  TFifo = class(TComponent)
          private
            FInPoi  : longint;                                 { input pointer }
            FOutPoi : longint;                                { output pointer }
            FLength : longint;                                { length of Fifo }
            FData   : array of byte;                            { data element }
            procedure SetSize (value: longint);
          public
            constructor Create (AOwner: TComponent); override;
            destructor  Destroy; override;
            procedure   Clear;
            function    PutByte (InByte: byte): boolean;
            function    LoadBack (InByte: Byte): boolean;
            function    ForceByte (InByte: byte): boolean;
            function    GetByte (var OutByte: byte): boolean;
            function    SenseByte (ix: longint;
                          var OutByte: byte): boolean;
            function    CountBytes: longint;
          published
            property Size: longint read FLength write SetSize;
          end;

  TDecodeSt = (rlData, rlLeadin, rlCnt);
  TRLEncoder = class (TComponent)
    private
      FBufLeng    : integer;                       { length of encoding buffer }
      FBuffer     : array of byte;                           { encoding buffer }
      FBufPoi     : integer;
      FLeadInByte : byte;                       { lead-in byte for RL encoding }
      FDecodeSt   : TDecodeSt;                                 { decoder state }
      FCount      : byte;                       { byte counter for en/decoding }
      FLastB      : byte;                                { last byte container }
      procedure SetBufLeng (leng: integer);
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure Reset;
      function  Decode (InByte: byte): boolean;
      function  Encode (var InBuf: array of byte; NumBytes: integer): boolean;
      procedure GetResult (var OutBuf: array of byte);
      function  Finish (var OutBuf: array of byte): integer;
    published
      property BufLeng: integer read FBufLeng write SetBufLeng;
    end;

  TAssocArray = class (TComponent)
    private
      FNEntries     : integer;
      FDataArray    : array of Variant;
      FKeyArray     : array of string;
      FGranularity  : integer;
      FIgnoreCase   : boolean;
      FDataID       : string;
      function GetKeys (ix: integer): string;
      function GetValues (ix: integer): Variant;
      procedure SetKeys (ix: integer; v: string);
      procedure SetValues (ix: integer; v: Variant);
    protected
      procedure AssignTo (Dest: TPersistent); override;
    public
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;
      procedure Add (Key: string; Value: Variant);
      procedure Assign(Source: TPersistent); override;
      procedure Clear;
      property Keys[ix: integer]: string read GetKeys write SetKeys;
      property NumEntries: integer read FNEntries;
      function Remove (Key: string): boolean;
      function Resolve (Key: string): Variant;
      function ResolveAsInt (Key: string): integer;
      function ResolveAsNumber (Key: string): double;
      function ResolveAsString (Key: string): string;
      property Values[ix: integer]: Variant read GetValues write SetValues;
      function AddXMLAttributes (Attributes: string): integer;
      function ReadFromXMLStream (const InStream: TStream; DataID: string): boolean;
      procedure WriteToXMLStream (const OutStream: TStream; CreateHeader: boolean;
                                  DataID: string);
    published
      property  DataID: string read FDataID write FDataID;
      property IgnoreCase: boolean read FIgnoreCase write FIgnoreCase;
      property Granularity: integer read FGranularity write FGranularity;
    end;

  TStringPool = array[1..SABuffSize] of byte;
  TStringArray = class (TComponent)
    private
      FNCol         : longint;                             { number of columns }
      FNRow         : longint;                                { number of rows }
      FAllocRowsBy  : longint;                { number of rows to be allocated }
      FRAllocated   : longint;            { number of rows currently allocated }
      FNumPoolAddr  : integer;                 { number of string pool buffers }
      FFirstFree    : array of longint; { offset of first free byte in buffers }
      FPoiArray     : array of array of longint; { array of pointers to string }
      FSortIx       : array of longint;                   { current sort index }
      FStgPool      : array of TStringPool;                      { string pool }
      FRowAttrib    : array of byte;                          { row attributes }
      FColAttrib    : array of byte;                       { column attributes }
      FOnChange     : TNotifyEvent;
      FOnBefSortExc : TBeforeSortExchgEvent;
      FOnPercentDone: TOnPercentDoneEvent;
      {$IFDEF SDLDEBUG}
      procedure GetDebugInfo (var SL: TStringList);
      {$ENDIF}

      function  GetAsNumber (c, r: longint): double;
      function  GetAsInteger (c, r: longint): integer;
      function  GetSortOrder (ix: longint): longint;
      function  GetString (c,r: longint): Shortstring;
      procedure SetString (c,r: longint; s: Shortstring);
      function  GetRowAttrib (r: longint): byte;
      procedure SetRowAttrib (r: longint; b: byte);
      function  GetColAttrib (c: longint): byte;
      procedure SetColAttrib (c: longint; b: byte);
      procedure SetNrCols (NrCols: longint);
      procedure SetNrRows (NrRows: longint);
      procedure SetSortOrder (ix: longint; position: longint);
      procedure SetAllocRowsBy (NrAllocRows: longint);
      function  FindCellIntern (FindStr: string; MatchCase: boolean; 
                    ColLow, ColHigh, RowLow, RowHigh: longint; 
                    var Col, row: longint; Exact: boolean): boolean;
    protected
      procedure AssignTo (Dest: TPersistent); override;
      procedure BeforeSortExchange (InString: string; var OutString: string);
    public
      constructor Create (AOwner: TComponent); override;
      destructor  Destroy; override;
      function  AddRow: longint;
      property  AsInteger [ACol, ARow: longint]: integer read GetAsInteger;
      property  AsNumber [ACol, ARow: longint]: double read GetAsNumber;
      procedure Assign(Source: TPersistent); override;
      procedure Changed;
      procedure Clear;
      property  ColAttrib [c: longint]: byte read GetColAttrib write SetColAttrib;
      function  ColumnEmpty (ACol: longint): boolean;
      procedure CommitSorting;
      procedure CopyRow (Source, Target: integer);
      property  Elem [c,r: longint]: ShortString
                    read GetString write SetString; default;
      procedure Fill (s: ShortString);
      function  FindCell (FindStr: string; MatchCase: boolean;
                    ColLow, ColHigh, RowLow, RowHigh: longint;
                    var Col, row: longint): boolean;
      function  FindCellExact (FindStr: string; MatchCase: boolean;
                    ColLow, ColHigh, RowLow, RowHigh: longint; 
                    var Col, row: longint): boolean;
      function  FindCellInSortedColumn (FindStr: string; MatchCase: boolean; 
                    ColIx, RowLow, RowHigh: longint; ColIsAscending: boolean; 
                    var row: longint): boolean;
      procedure GarbageCollection;
      procedure InsertColumn (c: longint);
      procedure InsertRow (r: longint);
      function  LoadFromXMLFile (FName: string; DataID: string): boolean;
      property  NumBuffers: integer read FNumPoolAddr;
      function  ReadFromOpenXMLFile (var InFile: TextFile; DataID: string): boolean;
      procedure RemoveColumn (c: longint);
      procedure RemoveRow (r: longint);
      function  Resize (Nc, Nr: longint): boolean;
      property  RowAttrib [r: longint]: byte read GetRowAttrib write SetRowAttrib;
      function  RowEmpty (ARow: longint): boolean;
      procedure SaveAsXMLFile (FName: string; DataID: string);
      procedure WriteToOpenXMLFile (var OutFile : TextFile; CreateHeader: boolean;
                    DataID: string);
      procedure Sort (PrimCol, SecCol: longint; Ascending: boolean); overload;
      procedure Sort (PrimCol, SecCol: longint;
                    AscendPrim, AscendSec: boolean); overload;
      property  SortOrder[ix: longint]: longint
                    read GetSortOrder write SetSortOrder;
      procedure UnSort;
    published
      property  AllocRowsBy: longint read FAllocRowsBy write SetAllocRowsBy;
      property  NrOfColumns: longint read FNCol write SetNrCols;
      property  NrOfRows: longint read FNRow write SetNrRows;
      property  OnChange: TNotifyEvent read FOnChange write FOnChange;
      property  OnPercentDone: TOnPercentDoneEvent
                    read FOnPercentDone write FOnPercentDone;
      property  OnBeforeSortExchange: TBeforeSortExchgEvent
                    read FOnBefSortExc write FOnBefSortExc;
    end;

  TFeatKind = (fkUndefined, fkInteger, fkDouble, fkString, fkTriState);

  TFeatMatProps = class (TComponent)
      private
        FFeatNum      : integer;    // assigned number of feature
        FFeatName     : string;     // name of feature
        FFeatKind     : TFeatKind;  // kind of feature (integer, string, ...)
        FComment      : string;     // any comment
        FPresetValues : string;     // preset values
        FSorted       : boolean;    // TRUE: show feature options as sorted list
        FGUIElem      : pointer;    // pointer to associated GUI element
      protected
        procedure AssignTo (Dest: TPersistent);
      public
        constructor Create (AOwner: TComponent); override;
        destructor  Destroy; override;
        procedure Assign(Source: TPersistent); override;
        procedure Clear;
        property FeatNum: integer read FFeatNum write FFeatNum;
        property FeatName: string read FFeatName write FFeatName;
        property FeatKind: TFeatKind read FFeatKind write FFeatKind;
        property Comment: string read FComment write FComment;
        property PresetValues: string read FPresetValues write FPresetValues;
        property Sorted: boolean read FSorted write FSorted;
        property GUIElem: pointer read FGUIElem write FGUIElem;
      end;

  TFeatureMatrix = class (TComponent)
      private
        FNFeats         : integer;                 // number of features
        FNObjs          : integer;                 // number of objects
        FFeatProps      : array of TFeatMatProps;  // feature types and properties
        FFeatVals       : array of array of string;// user defined features
        FOnChange       : TNotifyEvent;
        function GetNFeats: integer;
        procedure SetNFeats (NFt: integer);
        function GetNObjs: integer;
        procedure SetNObjs (NObjs: integer);
        function GetFeatProps (fix: integer): TFeatMatProps;
        procedure SetFeatProps (fix: integer; FeatMatProps: TFeatMatProps);
        function GetFeatValInt (fix, obj: integer): int64;
        procedure SetFeatValint (fix, obj: integer; FeatVal: int64);
        function GetFeatValDouble (fix, obj: integer): double;
        procedure SetFeatValDouble (fix, obj: integer; FeatVal: double);
        function GetFeatValTriState (fix, obj: integer): TTriState;
        procedure SetFeatValTriState (fix, obj: integer; FeatVal: TTriState);
        function GetFeatValStr (fix, obj: integer): string;
        procedure SetFeatValStr (fix, obj: integer; FeatVal: string);
      protected
        procedure AssignTo (Dest: TPersistent); override;
      public
        constructor Create (AOwner: TComponent); override;
        destructor  Destroy; override;
        procedure Assign(Source: TPersistent); override;
        procedure Changed;
        procedure Clear;
        procedure ClearFeature (feat: integer);
        procedure ClearObject (obj: integer);
        procedure CopyObject (Source, Target: integer);
        property FeatProps [fix: integer]: TFeatMatProps
                     read GetFeatProps write SetFeatProps;
        property FeatVal[fix, obj: integer]: string
                     read GetFeatValStr write SetFeatValStr; default;
        property FeatValAsInt[fix, obj: integer]: int64
                     read GetFeatValInt write SetFeatValInt;
        property FeatValAsDouble[fix, obj: integer]: double
                     read GetFeatValDouble write SetFeatValDouble;
        property FeatValAsTriState[fix, obj: integer]: TTriState
                     read GetFeatValTriState write SetFeatValTriState;
        function Fill (fix: integer; FeatVal: string): boolean; overload;
        function Fill (fix: integer; FeatVal: int64): boolean; overload;
        function Fill (fix: integer; FeatVal: double): boolean; overload;
        function Fill (fix: integer; FeatVal: TTriState): boolean; overload;
        function FindFeatName (Name: string): integer;
        function FindFeatNum (Num: integer): integer;
        function GenerateFeatNames (Template: string;
                      IxFrom, IxTo, FirstNum, Delta: integer): integer;
        procedure InsertFeature (feat: integer);
        procedure InsertObject (obj: integer);
        function Load (FName: string): integer;
        function LoadFromOpenFile (const IFile: TextFile): integer;
        procedure RemoveFeature (feat: integer);
        procedure RemoveObject (obj: integer);
        procedure RenumberFeatures (IxFrom, IxTo, FirstNum, Delta: integer);
        procedure ResetToDefault;
        function Resize (NFeats, NObjs: integer): boolean;
        procedure Save (FName: string);
        procedure SaveToOpenFile (const OFile: TextFile);
        procedure SetFeatType (IxFrom, IxTo: integer; FeatKind: TFeatKind);
      published
        property NFeatures: integer read GetNFeats write SetNFeats;
        property NObjects: integer read GetNObjs write SetNObjs;
        property OnChange: TNotifyEvent read FOnChange write FOnChange;
      end;

const
  FEATKINDIDS : array[TFeatKind] of string =
                ('undefined', 'integer', 'double', 'string', 'tristate');
  IDS_LOGICOP : array[TLogicOp] of string =
                ('AND', 'OR', 'XOR', 'ANDNOT', 'ORNOT', 'XORNOT');


  function CalcCRC32ofFile
              (FName : string)              { filename of file to be processed }
                     : longint;                                { resulting CRC }
  function CalcNextCRC16
             (inbyte : byte;                       { next byte of input stream }
                 crc : word)                                    { CRC register }
                     : word;                                   { resulting CRC }
  function CalcNextCRC32
             (inbyte : byte;                       { next byte of input stream }
                 crc : longint)                                 { CRC register }
                     : longint;                                { resulting CRC }
  function CRC16ofBuffer
             (Buffer : TBytes;                                  { input buffer }
             NumData : integer;
           CRC16Mode : TCRC16Mode)           { number of bytes in input buffer }
                     : word;                                      { CRC result }
  function CRC32ofBuffer
             (Buffer : TBytes;                                  { input buffer }
             NumData : integer)              { number of bytes in input buffer }
                     : longint;                                   { CRC result }
  function DecodeASCII85
           (InStream,                           { ASCII85 stream to be decoded }
           OutStream : TStream)                                 { decoded data }
                     : integer;                                 { error number }
  function DecodeBase64
           (InStream,                            { BASE64 stream to be decoded }
           OutStream : TStream)                                 { decoded data }
                     : integer;                                 { error number }
  procedure EncodeASCII85
           (InStream,                       { data stream to be BASE85 encoded }
           OutStream : TStream;                                 { encoded data }
          InsertCRLF : boolean);                         { TRUE: insert a CRLF }
  procedure EncodeBase64
           (InStream,                       { data stream to be BASE64 encoded }
           OutStream : TStream;                                 { encoded data }
          InsertCRLF : boolean);                         { TRUE: insert a CRLF }
  function IndexOfNearestArrayValue
              (Value : double;                          { value to be searched }
         ArrOfValues : array of double)                      { array of values }
                     : integer; overload;    { index of nearest value in array }
  function IndexOfNearestArrayValue
              (Value : integer;                         { value to be searched }
         ArrOfValues : array of integer)                     { array of values }
                     : integer; overload;    { index of nearest value in array }
  function NextCombination
   (var CurrentCombi : TCombination;                     { current combination }
              MaxVal : integer)                              { range of digits }
                     : boolean;                  { FALSE: no more combinations }
  function NextPermutation
  (var CurrentPermut : TCombination)                     { current permutation }
                     : boolean;                  { FALSE: no more permutations }
{$IFNDEF DOTNET}
  function SHA1DigestToHex
             (Digest : TSHACode)                              { SHA1 hash code }
                     : string;       { hexadecimal representation of hash code }
  function SHA1FromFile
        (const FName : string)                                    { input file }
                     : TSHACode;                              { SHA1 hash code }
  function SHA1FromStream
           (InStream : TStream)                                 { input stream }
                     : TSHACode;                              { SHA1 hash code }
{$IFDEF GE_LEV8}
  function SHA1FromString
     (const InString : string)                                  { input string }
                     : TSHACode; overload;                    { SHA1 hash code }
{$ENDIF}
  function SHA1FromString
     (const InString : AnsiString)                              { input string }
                     : TSHACode; overload;                    { SHA1 hash code }
  function SHA1FromStringOLd        // outdated version kept for compatibility
     (const InString : string)                                  { input string }
                     : TSHACode;                              { SHA1 hash code }

{$ENDIF}




Last Update: 2023-Feb-06