stvarr.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StVArr.pas 4.03                             *}
{*********************************************************}
{* SysTools: Virtual matrix class                        *}
{*********************************************************}

{$I StDefine.inc}

{$I+} {trap I/O exceptions here}

{Notes:
  - The virtual matrix uses a disk file for the main storage of a
    two-dimensional array. A specified number of rows from the matrix can
    be stored in a memory cache.

  - The cache must be large enough to hold at least 2 rows. In 16-bit mode,
    the cache can hold at most about 5460 rows. In 32-bit mode, the number
    of cached rows is essentially unlimited.

  - Normally the disk file is treated as a pure file of rows, where each
    row is composed of cell columns. By overriding the HeaderSize, WriteHeader,
    and ReadHeader methods, the application can use a file that has a header
    prior to the array data.

  - By defining a matrix of one column, the TStVMatrix class can be used
    as a cache manager for any file of record.
}

unit StVArr;

interface

uses
  Windows, Classes,
  SysUtils, StConst, StBase,
  StUtils; {used for ExchangeStructs}

type
 {.Z-}
  TStCacheRec = record
    crRow     : Cardinal;    {row number in cache}
    crRowData : Pointer;     {pointer to row buffer}
    crTime    : LongInt;     {quasi-time last used}
    crDirty   : Integer;     {non-zero if Row changed in memory}
  end;
  TStCacheArray = array[0..(StMaxBlockSize div SizeOf(TStCacheRec))-1] of TStCacheRec;
  PStCacheArray = ^TStCacheArray;
 {.Z-}

  TStVMatrix = class(TStContainer)
  {.Z+}
  protected
    {property instance variables}
    FRows     : Cardinal;   {number of rows}
    FCacheRows: Integer;    {number of cached rows}
    FCols     : Cardinal;   {number of columns}
    FElSize   : Integer;    {size of each array element}               

    {private instance variables}
    vmRowSize  : LongInt;    {number of bytes in a row}
    vmCacheCnt : Integer;    {number of used rows in cache}
    vmCacheTime: LongInt;    {quasi-time for LRU}
    vmCache    : PStCacheArray; {sorted collection of cached rows}
    vmDataF    : Integer;    {data file}

    {protected undocumented methods}
    procedure ForEachUntypedVar(Action : TIterateUntypedFunc;
                                OtherData : pointer);
      override;
    procedure GetArraySizes(var RowCount, ColCount, ElSize : Cardinal);
      override;
    procedure SetArraySizes(RowCount, ColCount, ElSize : Cardinal);
      override;
    function StoresUntypedVars : boolean;
      override;
    procedure vmSetCacheRows(CacheRows : Integer);
    procedure vmAllocateCache;
    procedure vmDeallocateCache;
    procedure vmInvalidateCache;
    procedure vmFlushCacheNode(CacheIndex : Integer);
    function vmIncCacheTime : LongInt;
    function vmSearchCache(Row : Cardinal; var CacheIndex : Integer) : Boolean;
    function vmGetRowData(Row : Cardinal; MakeDirty : Boolean) : Pointer;
    procedure vmWriteRow(Row : Cardinal; Data : Pointer; Seek : Boolean);
    procedure vmSetRows(Rows : Cardinal);

  {.Z-}
  public
    constructor Create(Rows, Cols, ElementSize : Cardinal;
                       CacheRows : Integer;
                       const DataFile : string; OpenMode : Word); virtual;
      {-Initialize a virtual 2D matrix}
    destructor Destroy; override;
      {-Free a virtual 2D matrix}
    procedure FlushCache;
      {-Write any dirty cache rows to disk}

    function HeaderSize : LongInt; virtual;
      {-Return the header size of the array file, default 0}
    procedure WriteHeader; virtual;
      {-Write a header to the array file, default none}
    procedure ReadHeader; virtual;
      {-Read a header from the array file, default none}

    procedure Assign(Source: TPersistent); override;
      {-Assign another container's contents to this one}
    procedure Clear; override;
      {-Fill the matrix with zeros}
    procedure Fill(const Value);
      {-Fill matrix with specified element value}

    procedure Put(Row, Col : Cardinal; const Value);
      {-Set an element}
    procedure Get(Row, Col : Cardinal; var Value);
      {-Return an element}

    procedure PutRow(Row : Cardinal; const RowValue);
      {-Set an entire row}
    procedure GetRow(Row : Cardinal; var RowValue);
      {-Return an entire row}

    procedure ExchangeRows(Row1, Row2 : Cardinal);
      {-Exchange the specified rows}
    procedure SortRows(KeyCol : Cardinal; Compare : TUntypedCompareFunc);
      {-Sort the array rows using the given comparison function and
        the elements in the given column}

    property Rows : Cardinal
      {-Read or write the number of rows in the array}
      read FRows
      write vmSetRows;

    property CacheRows : Integer
      {-Read or write the number of cache rows in the array}
      read FCacheRows
      write vmSetCacheRows;
    property Cols : Cardinal
      {-Read the number of columns in the array}
      read FCols;

    property ElementSize : Integer                                     
      {-Read the size of each element in the array}
      read FElSize;
  end;


implementation

function AssignMatrixData(Container : TStContainer;
                      var Data;
                          OtherData : Pointer) : Boolean; far;
  var
    OurMatrix : TStVMatrix absolute OtherData;
    RD : TAssignRowData absolute Data;
  begin
    OurMatrix.PutRow(RD.RowNum, RD.Data);
    Result := true;
  end;

procedure TStVMatrix.Assign(Source: TPersistent);
begin
  {$IFDEF ThreadSafe}
  EnterCS;
  try
  {$ENDIF}
    {The only containers that we allow to be assigned to a large matrix
     are:
       - a SysTools large array (TStLArray)
       - a SysTools large matrix (TStLMatrix)
       - another SysTools virtual matrix (TStVMatrix)}
    if not AssignUntypedVars(Source, AssignMatrixData) then
      inherited Assign(Source);
  {$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;{try..finally}
  {$ENDIF}
end;

procedure TStVMatrix.Clear;
var
  Row : Cardinal;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    vmInvalidateCache;
    vmCacheCnt := 1;
    with vmCache^[0] do begin
      HugeFillChar(crRowData^, vmRowSize, 0);
      crRow := 0;
      crTime := vmIncCacheTime;
      crDirty := 0;
      FileSeek(vmDataF, 0, 0);
      WriteHeader;
      for Row := 0 to FRows-1 do
        vmWriteRow(Row, crRowData, False);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStVMatrix.ForEachUntypedVar(Action : TIterateUntypedFunc;
                                       OtherData : pointer);
  var
    FullRow : ^TAssignRowData;
    i       : Cardinal;
  begin
  {$IFDEF ThreadSafe}
    EnterCS;
    try
  {$ENDIF}
      GetMem(FullRow, sizeof(Cardinal) + vmRowSize);
      try
        for i := 0 to pred(Rows) do
          begin
            FullRow^.RowNum := i;
            GetRow(i, FullRow^.Data);
            Action(Self, FullRow^, OtherData);
          end;
      finally
        FreeMem(FullRow, sizeof(Cardinal) + vmRowSize);
      end;
  {$IFDEF ThreadSafe}
    finally
      LeaveCS;
    end;
  {$ENDIF}
  end;

procedure TStVMatrix.GetArraySizes(var RowCount, ColCount, ElSize : Cardinal);
  begin
    RowCount := Rows;
    ColCount := Cols;
    ElSize := ElementSize;
  end;

procedure TStVMatrix.SetArraySizes(RowCount, ColCount, ElSize : Cardinal);
  begin
    if (ColCount <> Cols) then
      RaiseContainerError(stscBadColCount);
    if (LongInt(ElSize) <> ElementSize) then                           
      RaiseContainerError(stscBadElSize);
    if (RowCount <> Rows) then
      begin
        Rows := RowCount;
      end;
  end;

function TStVMatrix.StoresUntypedVars : boolean;
  begin
    Result := true;
  end;

constructor TStVMatrix.Create(Rows, Cols, ElementSize : Cardinal;
                              CacheRows : Integer;
                              const DataFile : string; OpenMode : Word);
begin
  FElSize := ElementSize;
  FRows := Rows;
  FCols := Cols;
  FCount := LongInt(Rows)*LongInt(Cols);
  vmRowSize := LongInt(Cols)*LongInt(ElementSize);
  FCacheRows := CacheRows;
  vmDataF := -1;

  CreateContainer(TStNode, 0);

  if (Rows = 0) or (Cols = 0) or (ElementSize = 0) or (CacheRows < 2) or
  ProductOverflow(Cols, ElementSize) or
  ProductOverflow(LongInt(Cols)*LongInt(ElementSize), Rows) or
  (LongInt(Cols)*LongInt(ElementSize)*LongInt(Rows) > MaxLongInt-HeaderSize) or
  (CacheRows > StMaxBlockSize div SizeOf(TStCacheRec)) then
    RaiseContainerError(stscBadSize);

  vmAllocateCache;

  {open the data file}
  vmDataF := FileOpen(DataFile, OpenMode);
  if vmDataF < 0 then begin
    {file not found, create it}
    vmDataF := FileCreate(DataFile);
    if vmDataF < 0 then
      RaiseContainerError(stscFileCreate)
    else begin
      FileClose(vmDataF);
      vmDataF := FileOpen(DataFile, OpenMode);
      if vmDataF < 0 then
        RaiseContainerError(stscFileOpen);
      {write user defined header to file}
      WriteHeader;
      FileSeek(vmDataF, 0, 0);
    end;
  end;

  {read user defined header from file}
  ReadHeader;
end;

destructor TStVMatrix.Destroy;
begin
  if Assigned(vmCache) then begin
    if vmDataF > 0 then
      FlushCache;
    vmDeallocateCache;
  end;

  if vmDataF > 0 then begin
    {write user defined header to file}
    FileSeek(vmDataF, 0, 0);
    WriteHeader;
    FileClose(vmDataF);
  end;

  IncNodeProtection;
  inherited Destroy;
end;

procedure TStVMatrix.ExchangeRows(Row1, Row2 : Cardinal);
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
{$IFOPT R+}
    if (Row1 >= Rows) or (Row2 >= Rows) then
      RaiseContainerError(stscBadIndex);
{$ENDIF}
    ExchangeStructs(vmGetRowData(Row1, True)^, vmGetRowData(Row2, True)^, vmRowSize);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStVMatrix.Fill(const Value);
var
  Row : Cardinal;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    vmInvalidateCache;
    vmCacheCnt := 1;
    with vmCache^[0] do begin
      HugeFillStruc(crRowData^, FCols, Value, FElSize);
      crRow := 0;
      crTime := vmIncCacheTime;
      crDirty := 0;
      FileSeek(vmDataF, 0, 0);
      WriteHeader;
      for Row := 0 to FRows-1 do
        vmWriteRow(Row, crRowData, False);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStVMatrix.FlushCache;
var
  I : Integer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    for I := 0 to vmCacheCnt-1 do
      vmFlushCacheNode(I);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStVMatrix.Get(Row, Col : Cardinal; var Value);
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
{$IFOPT R+}
    if (Row >= Rows) or (Col >= Cols) then
      RaiseContainerError(stscBadIndex);
{$ENDIF}
    Move(PChar(vmGetRowData(Row, False))[LongInt(Col)*FElSize], Value, FElSize);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStVMatrix.GetRow(Row : Cardinal; var RowValue);
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
{$IFOPT R+}
    if Row >= Rows then
      RaiseContainerError(stscBadIndex);
{$ENDIF}
    HugeMove(vmGetRowData(Row, False)^, RowValue, vmRowSize);