PIR/PIRTableConfigs.pas - master - YakuninAV/Convertors

PIR/PIRTableConfigs.pas
254 строки8 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
{*******************************************************}
{                                                       }
{       DBD PIR library                                 }
{                                                       }
{       Copyright (C) 2020 Databasis Development        }
{                                                       }
{*******************************************************}
///
unit PIRTableConfigs;

{$I Synopse.inc}

interface

uses
  SysUtils, Classes,
  SynCommons,
  DBDIntfs,
  PIRIntfs, PIRTypes;

type

  /// Базовый класс описателя элемента конфигурации таблицы
  TPIRTableConfigItem = class(TInterfacedObject, IPIRTableConfigItemV1)
  private
    function GetJSON: RawUTF8;
    function GetDoc: Variant;
    function GetFont: string;
    function GetColor: Integer;
    function GetEmpty: Boolean;
    function GetRange: TPIRTableRange;
    function GetSource: string;
    function GetSrcType: TPIRTableSourceType;
    procedure SetJSON(const Value: RawUTF8);
    procedure SetDoc(const Value: Variant);
    procedure SetFont(const Value: string);
    procedure SetColor(const Value: Integer);
    procedure SetEmpty(const Value: Boolean);
    procedure SetRange(const Value: TPIRTableRange);
    procedure SetSource(const Value: string);
    procedure SetSrcType(const Value: TPIRTableSourceType);
  strict protected
    FFont: string;
    FColor: Integer;
    FRange: TPIRTableRange;
    FSource: string;
    FSrcType: TPIRTableSourceType;
  public
    /// Признак отсутствия информации
    property Empty: Boolean read GetEmpty write SetEmpty;
    /// Строка, содержащая описание источника информации
    property Source: string read GetSource write SetSource;
    /// Тип источника информации
    property SrcType: TPIRTableSourceType read GetSrcType write SetSrcType;
    /// Фонт используемый для выделения источника в таблице
    property Font: string read GetFont write SetFont;
    /// Цвет используемый для выделения источника в таблице
    property Color: Integer read GetColor write SetColor;
    /// JSON-строка с информацией
    property JSON: RawUTF8 read GetJSON write SetJSON;
    /// JSON-документ с информацией
    property Doc: Variant read GetDoc write SetDoc;
    /// Область, занимаемая источником информации
    property Range: TPIRTableRange read GetRange write SetRange;
    /// Конструктор
    constructor Create(const aDoc: Variant); overload;
    /// Конструктор
    constructor Create(const aDoc: PDocVariantData); overload;
    constructor Create(const aSrc: string; const aSrcType: TPIRTableSourceType); overload;
    constructor CreateCol(const aCol: Integer; const aSrcType: TPIRTableSourceType=pirTSTAddress);
    constructor CreateRow(const aRow: Integer; const aSrcType: TPIRTableSourceType=pirTSTAddress);
    /// Очищает информацию об источнике
    procedure Clear; virtual;
    /// Функция загружает информацию из JSON-документа
    function FromPDoc(const aDoc: PDocVariantData): Boolean;
    /// Функция извлекает текст из таблицы
    function GetText(const aTable: PDocVariantData; const aRow, aCol: Integer): string; virtual; abstract;
    /// Функция проверяет что ячейка принадежит области источника данных
    function CellInSourceRegion(const aRow, aCol: Integer): Boolean;
  end;

  TPIRQuotationName = class(TPIRTableConfigItem)
  public
    constructor Create(const aSrc: string; const aSrcType:TPIRTableSourceType=pirTSTAddress); overload;
  end;

  TPIRQuotationUnit = class(TPIRTableConfigItem)
  public
    constructor Create(const aSrc: string; const aSrcType:TPIRTableSourceType=pirTSTConst); overload;
  end;

implementation

{ TPIRTableConfigBase }

function TPIRTableConfigItem.CellInSourceRegion(const aRow, aCol: Integer): Boolean;
begin
  Result := (aRow>=FRange.Top) and (aCol>=FRange.Left)
        and ((FRange.Bottom<0) or (aRow<=FRange.Bottom))
        and ((FRange.Right<0) or (aCol<=FRange.Right));
end;

procedure TPIRTableConfigItem.Clear;
begin
  SetFont(''); SetColor(0); SetSource(''); SetSrcType(pirTSTConst);
end;

constructor TPIRTableConfigItem.Create(const aSrc: string; const aSrcType: TPIRTableSourceType);
begin
  inherited Create;
  Clear;
  SetSource(aSrc); SetSrcType(aSrcType);
end;

constructor TPIRTableConfigItem.CreateCol(const aCol: Integer; const aSrcType: TPIRTableSourceType);
var rng: TPIRTableRange;
begin
  rng:=TPIRTableRange.CreateCol(aCol,-1);
  Create('',aSrcType);
end;

constructor TPIRTableConfigItem.CreateRow(const aRow: Integer; const aSrcType: TPIRTableSourceType);
begin
  Create('',aSrcType);
end;

constructor TPIRTableConfigItem.Create(const aDoc: Variant);
begin
  inherited Create;
  FromPDoc(_Safe(aDoc));
end;

constructor TPIRTableConfigItem.Create(const aDoc: PDocVariantData);
begin
  inherited Create;
  FromPDoc(aDoc);
end;

function TPIRTableConfigItem.FromPDoc(const aDoc: PDocVariantData): Boolean;
var r: RawUTF8; i: Integer;
begin
  Result := aDoc^.Kind=dvObject;
  if Result then begin
    if aDoc^.GetAsRawUTF8('src', r) then SetSource(UTF8ToString(r)) else SetSource('');
    if aDoc^.GetAsInteger('srt', i) then SetSrcType(TPIRTableSourceType(i)) else SetSrcType(pirTSTConst);
    if aDoc^.GetAsRawUTF8('fnt', r) then SetFont(UTF8ToString(r)) else SetFont('');
    if aDoc^.GetAsInteger('clr', i) then SetColor(i) else SetColor(0);
  end else Clear;
end;

function TPIRTableConfigItem.GetColor: Integer;
begin
  Result:=FColor;
end;

function TPIRTableConfigItem.GetDoc: Variant;
begin
  TDocVariant.New(Result);
  TDocVariantData(Result).AddValue('src', StringToUTF8(FSource));
  TDocVariantData(Result).AddValue('srt', Ord(FSrcType));
  TDocVariantData(Result).AddValue('fnt', StringToUTF8(FFont));
  TDocVariantData(Result).AddValue('cls', FColor);
end;

function TPIRTableConfigItem.GetEmpty: Boolean;
begin
  result := (FSource='');
end;

function TPIRTableConfigItem.GetFont: string;
begin
  Result:=FFont;
end;

function TPIRTableConfigItem.GetJSON: RawUTF8;
var v: Variant;
begin
  v:=GetDoc;
  Result := TDocVariantData(v).ToJSON()
end;

function TPIRTableConfigItem.GetRange: TPIRTableRange;
begin
  Result := FRange;
end;

function TPIRTableConfigItem.GetSource: string;
begin
  Result:=FSource;
end;

function TPIRTableConfigItem.GetSrcType: TPIRTableSourceType;
begin
  Result:=FSrcType;
end;

procedure TPIRTableConfigItem.SetColor(const Value: Integer);
begin
  FColor:=Value;
end;

procedure TPIRTableConfigItem.SetDoc(const Value: Variant);
begin
  FromPDoc(_Safe(Value));
end;

procedure TPIRTableConfigItem.SetEmpty(const Value: Boolean);
begin
  if Value then Clear;
end;

procedure TPIRTableConfigItem.SetFont(const Value: string);
begin
  FFont:=Value;
end;

procedure TPIRTableConfigItem.SetJSON(const Value: RawUTF8);
var v: Variant;
begin
  TDocVariant.New(v);
  if TDocVariantData(v).InitJSON(Value) then FromPDoc(_Safe(v)) else Clear;
end;

procedure TPIRTableConfigItem.SetRange(const Value: TPIRTableRange);
begin
  FRange:=Value;
end;

procedure TPIRTableConfigItem.SetSource(const Value: string);
begin
  FSource:=Value;
end;

procedure TPIRTableConfigItem.SetSrcType(const Value: TPIRTableSourceType);
begin
  FSrcType:=Value;
end;

{ TPIRQuotationName }

constructor TPIRQuotationName.Create(const aSrc: string; const aSrcType: TPIRTableSourceType);
var rng: TPIRTableRange;
begin
  inherited Create(aSrc, aSrcType)
end;

{ TPIRQuotationUnit }

constructor TPIRQuotationUnit.Create(const aSrc: string; const aSrcType: TPIRTableSourceType);
begin

end;

end.