PIR/PIRTableForm.pas - master - YakuninAV/Convertors

PIR/PIRTableForm.pas
401 строка14 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit PIRTableForm;
{$I Synopse.inc}
interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Grids, Vcl.Menus,
  SynCommons,
  PIRImportConsts, PIRTypes, VirtualTrees, Vcl.ComCtrls, Vcl.Buttons;

type
  TformPIRTable = class(TForm)
    panTop: TPanel;
    edtTabID: TEdit;
    edtTabName: TEdit;
    eRows: TEdit;
    lRows: TLabel;
    lCols: TLabel;
    eCols: TEdit;
    Label1: TLabel;
    lName: TLabel;
    popmTable: TPopupMenu;
    mnHeader: TMenuItem;
    mnName: TMenuItem;
    mnUnit: TMenuItem;
    vstTable: TVirtualStringTree;
    pgCtlTableConfig: TPageControl;
    tsComon: TTabSheet;
    Splitter1: TSplitter;
    eColLeft: TLabeledEdit;
    eRowTop: TLabeledEdit;
    udColLeft: TUpDown;
    udRowTop: TUpDown;
    eColRight: TLabeledEdit;
    udColRight: TUpDown;
    eRowBottom: TLabeledEdit;
    udRowBottom: TUpDown;
    cbxPriceKind: TComboBox;
    tsName: TTabSheet;
    eQuotationNamePrefix: TLabeledEdit;
    eQuotationName: TLabeledEdit;
    eQuotationNameSuffix: TLabeledEdit;
    chkAddTableName: TCheckBox;
    tsPriceUnit: TTabSheet;
    cbxQuotationUnitType: TComboBox;
    eQuotationUnit: TLabeledEdit;
    chkDefaultVolumeParam: TCheckBox;
    eFrameTLCell: TLabeledEdit;
    N1: TMenuItem;
    mnuTestQuotation: TMenuItem;
    chkRowID: TCheckBox;
    rbDummy: TRadioButton;
    rbQuotationsCont: TRadioButton;
    rbQuotationsTable: TRadioButton;
    cbxPriceScale: TComboBox;
    cbxPrefixKind: TComboBox;
    cbxNameKind: TComboBox;
    cbxSuffixKind: TComboBox;
    eFrameBRCell: TLabeledEdit;
    btnAddParam: TSpeedButton;
    eHeadSize: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure grdTableDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure mnItemClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure vstTableGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: string);
    procedure vstTableColumnWidthDblClickResize(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; P: TPoint;
      var Allowed: Boolean);
    procedure vstTableBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuTestQuotationClick(Sender: TObject);
  private
    FPTable: PDocVariantData;
    FKeyNotify: TOnKeyNotify;
    { Private declarations }
    Initialized: Boolean;
    PRows: PDocVariantData;
    PConfig: PDocVariantData;
    TableDescr: TPIRTableDescriptor;
    TabFrameConfig: Variant;
    Modified: Boolean;
    procedure Init;
    procedure SetPTable(const Value: PDocVariantData);
    procedure PrepareTable;
    function CheckTableConfig(const PDoc: PDocVariantData): Boolean;
    function MakeConfig:TPIRTableDescriptor;
  public
    { Public declarations }
    property PTable: PDocVariantData read FPTable write SetPTable;
    property KeyNotify: TOnKeyNotify read FKeyNotify write FKeyNotify;
  end;

var
  formPIRTable: TformPIRTable;

implementation

{$R *.dfm}

uses PIRTableDescriptionForm;

type
  vstNodeData = record
    PRow: PDocVariantData;
  end;
  PvstNodeData = ^vstNodeData;

function TformPIRTable.CheckTableConfig(const PDoc: PDocVariantData): Boolean;
var v: Variant;
begin
  Result:=PDoc^.GetAsDocVariant(pirTableDescriptorUTF8, PConfig);
  if not Result then begin
    TDocVariant.New(v);
    TableDescr.Clear;
    v:=TableDescr.ToDoc;
    PDoc^.AddValue(pirTableDescriptorUTF8,v);
    Result:=PDoc^.GetAsDocVariant(pirTableDescriptorUTF8,PConfig);
    Modified:=True;
    if Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('mody'));
  end;
end;

procedure TformPIRTable.FormActivate(Sender: TObject);
begin
  if not Initialized then begin
    Init;
  end;
end;

procedure TformPIRTable.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    if Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('close'));
end;

procedure TformPIRTable.FormCreate(Sender: TObject);
begin
  Initialized:=False;
  TDocVariant.New(TabFrameConfig);
end;

procedure TformPIRTable.FormDeactivate(Sender: TObject);
begin
  if Modified and Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('mody'));
end;

procedure TformPIRTable.grdTableDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var s:string; p: PDocVariantData; v: Variant; CellColor: TColor; CellFont: string;
    br: TBrush; pn: TPen; fnt: TFont;
begin
  p:=PRows^._[ARow]; if p=nil then Exit;
  br:=Canvas.Brush;
  pn:=Canvas.Pen;
  fnt:=Canvas.Font;
  if p^.Count>ACol then begin
    v:=p^.Values[ACol];
    if      TDocVariantData(v).Kind=dvArray  then s:='[..]'
    else if TDocVariantData(v).Kind=dvObject then s:='{..}'
    else begin
      if v=null then s:='null'
      else begin
        if TableDescr.CellProps(ARow,ACol, CellColor, CellFont) then begin
//          grdTable.Canvas.Brush.Color:=clYellow;
//          grdTable.Canvas.Brush.Style:=bsSolid;
        end;
        s:=UTF8ToString(v);
      end;
    end;
  end;
  {
  grdTable.Canvas.FillRect(Rect);
  grdTable.Canvas.TextRect(Rect,s);
  grdTable.Canvas.Brush:=br;
  grdTable.Canvas.Font:=fnt;
  }
 end;

procedure TformPIRTable.Init;
begin
  Initialized:=True;
end;

function TformPIRTable.MakeConfig: TPIRTableDescriptor;
var v, arr: Variant; p,conf: PDocVariantData;
  t: TPIRTableDescriptor; fr, nm, un: TPIRItemDescriptor; srcType: TPIRTableSourceTypes;
begin
  Result:=TPIRTableDescriptor.Create(nil);
  Result.ID:=edtTabID.Text;
  Result.Name:=edtTabName.Text;
  Result.TabNameToRow:=chkAddTableName.Checked;
  Result.RowID:=chkRowID.Checked;
  if      rbQuotationsTable.Checked then Result.Kind:=pirTKQuotation
  else if rbQuotationsCont.Checked  then Result.Kind:=pirTKContinue
  else                                   Result.Kind:=pirTKDummy;
  if      cbxPriceKind.ItemIndex=0 then Result.PriceKind:=pirTPKparamA
  else if cbxPriceKind.ItemIndex=1 then Result.PriceKind:=pirTPKparamB
  else if cbxPriceKind.ItemIndex=2 then Result.PriceKind:=pirTPKparamAB
  else                                  Result.PriceKind:=pirTPKparamBA;
  if      cbxPriceScale.ItemIndex=0 then Result.MeashureOfPrice:=pirTMPRouble
  else if cbxPriceScale.ItemIndex=1 then Result.MeashureOfPrice:=pirTMPThousand
  else                                   Result.MeashureOfPrice:=pirTMPMillion;
  fr:=TPIRItemDescriptor.CreateFrame(TPIRTableCell.Create(-1,-1),TPIRTableCell.Create(-1,-1));

  Result.RC_Data:=fr;
  case cbxNameKind.ItemIndex of
    0: nm:=TPIRItemDescriptor.Create(pirTSTConst, '');                      //�����
    1: nm:=TPIRItemDescriptor.Create(pirTSTAddress, eQuotationName.Text);   //�����
    2: nm:=TPIRItemDescriptor.Create(pirTSTConst, eQuotationName.Text);     //�����
    3: nm:=TPIRItemDescriptor.Create(pirTSTText, eQuotationName.Text);      //������
  end;
  Result.RC_Name:=nm;
  case cbxNameKind.ItemIndex of
    0: nm:=TPIRItemDescriptor.Create(pirTSTConst, '');                      //�����
    1: nm:=TPIRItemDescriptor.Create(pirTSTAddress, eQuotationName.Text);   //�����
    2: nm:=TPIRItemDescriptor.Create(pirTSTConst, eQuotationName.Text);     //�����
    3: nm:=TPIRItemDescriptor.Create(pirTSTText, eQuotationName.Text);      //������
  end;
  Result.RC_Prefix:=nm;
  case cbxNameKind.ItemIndex of
    0: nm:=TPIRItemDescriptor.Create(pirTSTConst, '');                      //�����
    1: nm:=TPIRItemDescriptor.Create(pirTSTAddress, eQuotationName.Text);   //�����
    2: nm:=TPIRItemDescriptor.Create(pirTSTConst, eQuotationName.Text);     //�����
    3: nm:=TPIRItemDescriptor.Create(pirTSTText, eQuotationName.Text);      //������
  end;
  Result.RC_Suffix:=nm;
  case cbxQuotationUnitType.ItemIndex of
    0: un:=TPIRItemDescriptor.Create(pirTSTConst, eQuotationUnit.Text);    // ���������
    1: un:=TPIRItemDescriptor.Create(pirTSTAddress, eQuotationUnit.Text);  // ������
    2: un:=TPIRItemDescriptor.Create(pirTSTNameTail, eQuotationName.Text); // � ������ ������
  end;
  Result.RC_Unit:=un;
  Result.HaveDefaultVolumeParameter:=chkDefaultVolumeParam.Checked;
{
//  t.AddParam()
  conf:=_Safe(TabFrameConfig);
  conf^.Reset;
  TDocVariant.New(v);
  p:=_Safe(v);
  p^.AddValue('left',StringToUTF8(eColLeft.Text));
  p^.AddValue('top',StringToUTF8(eRowTop.Text));
  p^.AddValue('rght',StringToUTF8(eColRight.Text));
  p^.AddValue('bttm',StringToUTF8(eRowBottom.Text));
  p^.AddValue('cell', StringToUTF8(eFrameTLCell.Text));
  p^.AddValue('rows', -1);
  p^.AddValue('cols', -1);
  p^.AddValue('tpk', 2); //��� ����  ��
  p^.AddValue('rid', true);
  conf^.AddValue('frame', v);
//  TDocVariant.New(vn);
//  p:=_Safe(vn);
  p^.Reset;
  p^.AddValue('tabn',chkAddTableName.Checked);
  p^.AddValue('cell',StringToUTF8(eQuotationName.Text));
  p^.AddValue('pref',StringToUTF8(eQuotationNamePrefix.Text));
  p^.AddValue('suff',StringToUTF8(eQuotationNameSuffix.Text));
  conf^.AddValue('name',v);
//  TDocVariant.New(vu);
//  p:=_Safe(vu);
  p^.Reset;
  p^.AddValue('cell',StringToUTF8(eQuotationUnit.Text));
  p^.AddValue('type',StringToUTF8(cbxQuotationUnitType.Text));
  p^.AddValue('cell',StringToUTF8(eQuotationUnit.Text));
  p^.AddValue('dfvol',chkDefaultVolumeParam.Checked);
  conf^.AddValue('unit',v);
}
end;

procedure TformPIRTable.mnItemClick(Sender: TObject);
var Row,Col: Integer; it: TPIRItemDescriptor;  ce:TPIRTableCell;
begin
  if Sender=mnHeader then begin
    Modified:=True;
    if Modified and Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('mody'));
  end else if Sender=mnName then begin
  end else if Sender=mnUnit then begin
    Modified:=True;
    if Modified and Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('mody'));
  end;
end;

procedure TformPIRTable.mnuTestQuotationClick(Sender: TObject);
var p,t:PDocVariantData; r: RawUTF8; i,j: Integer;
    Node: PVirtualNode; d: PvstNodeData;
    frRowT, frColL, frRowB, frColR, frRow, frCol: Integer;
    PricePartsQty: Integer;
    tName: string; tID: string;
begin
  p:=_Safe(TabFrameConfig);
  if p^.Count<1 then Exit;
  if not p^.GetAsDocVariant('frame',t) then begin
    Exit;
  end;
  if not p^.GetAsRawUTF8('cell', r) then  begin
    Exit;
  end;
  frRowT:=2;
  frColL:=2;
  frRow:=frRowT;
  frCol:=frColL;
  frRowB:=-1; if frRowB<frRowT then frRowB:=PRows^.Count;
  frColR:=-1; if frColR<frColL then frColR:=PRows^._[0]^.Count;
  PricePartsQty:=2;
  while frRow<=frRowB do begin   // ���� �� �������
    while frCol<=frColR do begin // ���� �� ��������

      Inc(frCol,PricePartsQty);
    end;                         // ���� �� ��������
    Inc(frRow);
  end;                           // ���� �� �������
end;

procedure TformPIRTable.PrepareTable;
var i: Integer; p: PVirtualNode; d: PvstNodeData; c: TVirtualTreeColumn;  s: string;
begin
  if FPTable<>nil then begin
    edtTabID.Text:=FPTable^.S[pirTableDescrIdUTF8];
    edtTabName.Text:=FPTable^.S[pirTableDescrNameUTF8];
    eRows.Text := PRows^.Count.ToString;
    eCols.Text := PRows^._[0]^.Count.ToString;
    i :=FPTable^.I[pirTableHeaderSizeUTF8];
    eHeadSize.Text:=i.ToString;
    vstTable.BeginUpdate;
    try
      vstTable.Clear;
      vstTable.NodeDataSize:=SizeOf(vstNodeData);
      vstTable.Header.Columns.Clear;
      vstTable.Header.Options:=vstTable.Header.Options + [hoColumnResize, hoHeightResize]    ;
      c := vstTable.Header.Columns.Add;
      c.Text:='cr';
      for i := 0 to PRows^._[0]^.Count-1 do begin
        c := vstTable.Header.Columns.Add;
        c.Text:='c'+ i.ToString;
        if i>1 then begin
          c.Width:=50;
          c.MinWidth:=50;
          c.MaxWidth:=300;
        end;
        c.Options := c.Options + [coResizable,coAllowClick,coSmartResize];
      end;
      for i := 0 to PRows^.Count-1 do begin
        p:=vstTable.AddChild(nil);
        d:=vstTable.GetNodeData(p);
        d^.PRow:=PRows^._[i];
      end;
      vstTable.Header.AutoFitColumns(True,smaUseColumnOption,1);
    finally
      vstTable.EndUpdate;
    end;
  end;
end;

procedure TformPIRTable.SetPTable(const Value: PDocVariantData);
var p: PDocVariantData;
begin
  if Value=nil then begin Close; Exit; end;
  p:=FPTable; FPTable := Value;
  Modified:=False;
  if FPTable^.GetAsDocVariant(pirTableDataUTF8, PRows) and
     (PRows^.Count>0) and (PRows^._[0]^.Count>1)
     and CheckTableConfig(FPTable) then PrepareTable
  else if FPTable <> nil then begin
    FPTable := p;
    CheckTableConfig(FPTable);
    PrepareTable;
  end else Close;
end;

procedure TformPIRTable.vstTableBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
  Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var br: TBrush; pn: TPen; fnt: TFont;
    it: TPIRItemDescriptor;  ce:TPIRTableCell;
begin
  if TableDescr.RC_Name.CellTL.Col+1=Column then begin
    br := TargetCanvas.Brush;
    TargetCanvas.Brush.Color:=clOlive;
    TargetCanvas.FillRect(CellRect);
    TargetCanvas.Brush:=br;
  end;
end;

procedure TformPIRTable.vstTableColumnWidthDblClickResize(Sender: TVTHeader; Column: TColumnIndex; Shift: TShiftState; P: TPoint;
  var Allowed: Boolean);
begin
  vstTable.Header.Columns[Column].Width :=150;
  Allowed:=True;
end;

procedure TformPIRTable.vstTableGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var d: PvstNodeData;
    br: TBrush; pn: TPen; fnt: TFont;
begin
  d:=vstTable.GetNodeData(Node);
  if      Column=0               then CellText:='r'+Node^.Index.ToString
  else if Column<=d^.PRow^.Count then CellText:= d^.PRow^[Column-1]
  else                                CellText:='';
end;

end.