RDB2/RDB2_EventTypes.pas - master - YakuninAV/Convertors

RDB2/RDB2_EventTypes.pas
479 строк13 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit RDB2_EventTypes;

{$I mormot.defines.inc}

interface

uses
{$IFDEF ISDELPHIXE2}
  System.SysUtils, System.Classes, System.Variants,
{$ELSE}
  SysUtils, Classes, Variants,
{$ENDIF}
  mormot.core.base, mormot.core.variants,
  DBDCommons, DBDStrUtils, DBDUtils,
 {$IFDEF ISDELPHIXE2} RDB2_TLB_XE {$ELSE} RDB2_TLB {$ENDIF}
  ;
const

  evt_BeforeCellInput = '1';
  evt_AfterTransmit   = '2';
  evt_CurPrepare      = '3';
  evt_PlugIn          = '4';
  evt_AfterPaste      = '5';
  evt_OnRecalcExtData = '6';
  evt_OnAutoRecalcCell= '7';
  {evt_Custom>= 10000}

type
{$IFDEF DELPHIXE2}
  String1251 = type AnsiString(1251);
{$ELSE}
  {$IFDEF FPC}
  String1251 = type AnsiString(1251);
  {$ELSE}
  String1251 = type AnsiString;
  {$ENDIF}
{$ENDIF}

  PEvCellInputParams = ^TEvCellInputParams;
  TEvCellInputParams = packed record
    Text: String1251;
  end;

  PAfterTransmitParams= ^TAfterTransmitParams;
  TAfterTransmitParams= packed record
    SourceBook: IBook;
    SourceCursor: IDataCursor;
    SourceField: String1251;
    Method: String1251;
  end;

  PEvCurPrepareParams = ^TEvCurPrepareParams;
  TEvCurPrepareParams = packed record
    ID: String1251;
  end;

  PEvPlugInParams = ^TEvPlugInParams;
  TEvPlugInParams = packed record
    Selection: OleVariant;
  end;

  PEvAfterPasteParams = ^TEvAfterPasteParams;
  TEvAfterPasteParams = packed record
    Pos,Count: integer;
  end;

const
  red_OnCommand = 0;
  red_OnTmpSave = 1;
  red_OnSaveDoc = 2;
  red_OnPrint   = 3;
  red_OnAddAct  = 4;
  red_OnDelAct  = 5;
  red_ChangeFactors = 6;
  
type
  PEvOnRecalExtDataParams = ^TEvOnRecalExtDataParams;
  TEvOnRecalExtDataParams = packed record
    Reason: integer;
  end;

const

  evf_Handle      = 1;
  evf_Error       = 2;
  evf_NoStdAction = 4; //��� evt_BeforeCellInput - ��������� �� ����������� ������� ������ ���������
  evf_NotModified = 4; //8; //��� evt_PlugIn - ������������ � ���, ��� �������� � ����� ��������� �� �������������

  /// ������ �������
  evs_Default     = 1;
  evs_Fixed       = 2;
  evs_Hidden      = 4;
  evs_Auto        = 8;

type

  TRDBEventLocation= packed record
    EvType,Project,Driver,DocType,TabName,Level,Cell: String1251;
  end;

  TRDBEvent= packed record
    Location: TRDBEventLocation;
    Document: IBook;
    Table   : IRDBOleTable;
    Actions : String1251;
    Flags   : integer;
    Params  : pointer;
    Custom  : OleVariant;
  end;

const

  edf_String  = 1;
  edf_Integer = 2;
  edf_Date    = 3;
  edf_Currency= 4;
  edf_Float   = 5;
  edf_Bool    = 6;
  edf_Enum    = 7;
  edf_FileName= 8;

  epf_OnParam = 1;
  epf_OpenAfterExecute = 2;

type

  PRDBHandlerParamInfo= ^TRDBHandlerParamInfo;
  /// ��������, ������������ ����������� �������
  TRDBHandlerParamInfo= packed record
    /// ������������� ���������
    ParamID: String1251;
    /// ������������� ������� ������  (edf_XXXX)
    DataFormat,
    ///
    Style: word;
    /// ���������
    Header,
    ///
    Caption,
    /// ���������
    Hint,
    /// �������� �� ���������
    Default,
    /// ������� ��������, ������� ����� ��������� ��������
    ValList: String1251;
    /// �������� �� ������ ���� �����
    Left,
    /// �������� �� �������� ���� �����
    Top,
    /// ������
    Width,
    /// ������
    Height: integer;
    ///
    Grid: String1251;
    ///
    Flags: word;
    /// ��������� �� ��������� ��������
    NextParam: PRDBHandlerParamInfo;
  end;

  PRDBHandlerInfo= ^TRDBHandlerInfo;
  /// ���������� �� ����������� �������
  TRDBHandlerInfo= packed record
    ///
    Location: TRDBEventLocation;
    /// ��������
    Action: String1251;
    /// ������������
    Name: String1251;
    /// ���������
    Caption: String1251;
    /// ���������
    Priority: integer;
    /// ������
    Status: integer;
    /// ������
    FormWidth: integer;
    /// ������
    FormHeight: integer;
    /// ���������� � ���������� ��� �����������
    ParamsInfo: PRDBHandlerParamInfo;
  end;

  TRDBHandleEventProc= function(var Event: TRDBEvent; const ClientParams: OleVariant): boolean; stdcall;
  TGetRDBHandlerInfo= function(Index: integer; var Info: OleVariant): TRDBHandleEventProc; stdcall;

const

  EvLocationLen = SizeOf(TRDBEventLocation) div SizeOf(String1251);
  StdGetInfoProcName= 'GetEventHandlerInfo';

function LocItemIn(const LocItem,Loc: String1251): boolean;
function EvLocationIn(const Location,Container: TRDBEventLocation): boolean;
procedure FreeRDBEventParams(var Event: TRDBEvent);
function RDBEventToVar(const Event: TRDBEvent): OleVariant;
procedure VarToRDBEvent(const VarEvent: OleVariant; var Event: TRDBEvent);
function HandlerInfoToVar(const Info: TRDBHandlerInfo): OleVariant;
procedure VarToHandlerInfo(const VarInfo: OleVariant; var Info: TRDBHandlerInfo);

implementation

procedure CheckEventLocation(var E: TRDBEvent);
var s: string;
begin
  s:=E.Document.ProjName; if E.Location.Project='' then E.Location.Project:=s;
  s:=E.Document.Author;   if E.Location.Driver='' then E.Location.Driver:=s;
  s:=E.Document.TypeName; if E.Location.DocType='' then E.Location.DocType:=s;
  s:=E.Table.Name;        if (E.Location.TabName='') and (E.Table <> nil) then E.Location.TabName:=s;
  if (E.Location.Level='') and (E.Table <> nil) then E.Location.Level:=IntToStr(E.Table.Cursor.Level);
end;

function LocItemIn(const LocItem,Loc: String1251): boolean;
begin
//  Result:=(StrItemIn(LocItem, Loc, ',')) or (Loc = '');
  //FindCSVIndex
  Result:=(Loc='') or (Pos(','+LocItem+',',','+Loc+',')>0)
end;

function EvLocationIn(const Location,Container: TRDBEventLocation): boolean;
var
  i: integer;
begin
  Result:=true;
  i:=0;
  while (Result) and (i<EvLocationLen) do
    begin
      Result:=LocItemIn(PStringArray(@Location)[i],PStringArray(@Container)[i]) and Result;
      inc(i);
    end;
end;

function EvLocationEquals(const L1,L2: TRDBEventLocation): boolean;
var
  i: integer;
begin
  Result:=true;
  i:=0;
  while (Result) and (i<EvLocationLen) do
    begin
      Result:=(PStringArray(@L1)[i]=PStringArray(@L2)[i]) and Result;
      inc(i);
    end;
end;

function EvLocationToVar(const EvLocation: TRDBEventLocation): OleVariant;
begin
  Result:=StringsBufToVar(EvLocation, EvLocationLen);
end;

procedure VarToEvLocation(const SourceVar: OleVariant; var EvLocation: TRDBEventLocation);
begin
  VarToStringsBuf(SourceVar, EvLocation);
end;

function EvParamsToVar(const EvType: String1251; const Params): OleVariant;
begin
  case StrToInt(EvType) of
    1: Result:=TEvCellInputParams(Params).Text;
    2: with TAfterTransmitParams(Params) do
       begin
         Result:=VarArrayCreate([1,4],varVariant);
         Result[1]:=SourceBook;
         Result[2]:=SourceCursor;
         Result[3]:=SourceField;
         Result[4]:=Method;
       end;
    3: Result:=TEvCurPrepareParams(Params).ID;
    4: Result:=TEvPlugInParams(Params).Selection;
    5: with TEvAfterPasteParams(Params) do
       begin
         Result:=VarArrayCreate([1,2],varInteger);
         Result[1]:=Pos;
         Result[2]:=Count;
       end;
    6: Result:=TEvOnRecalExtDataParams(Params).Reason;
  end;
end;

procedure VarToEvParams(const VarParams: OleVariant; const EvType: String1251; var Params);
begin
  case StrToInt(EvType) of
    1: TEvCellInputParams(Params).Text:=VariantToString(varParams);
    2: with TAfterTransmitParams(Params) do
       begin
         SourceBook:=IDispatch(VarParams[1]) as IBook;
         SourceCursor:=IDispatch(VarParams[2]) as IDataCursor;
         SourceField:=VariantToString(VarParams[3]);
         Method:=VariantToString(VarParams[4]);
       end;
    3: TEvCurPrepareParams(Params).ID:=VariantToString(varParams);
    4: TEvPlugInParams(Params).Selection:=VariantToString(VarParams);
    5: with TEvAfterPasteParams(Params) do
       begin
         Pos:=VarParams[1];
         Count:=VarParams[2];
       end;
    6: TEvOnRecalExtDataParams(Params).Reason:=VarParams;
  end;
end;

function NewEvParams(const EvType: String1251): pointer;
begin
  case StrToInt(EvType) of
    1: New(PEvCellInputParams(Result));
    2: New(PAfterTransmitParams(Result));
    3: New(PEvCurPrepareParams(Result));
    4: New(PEvPlugInParams(Result));
    5: New(PEvAfterPasteParams(Result));
    6: New(PEvOnRecalExtDataParams(Result));
    else Result:=nil;
  end;
end;

procedure DisposeEvParams(const EvType: String1251; var Params: pointer);
begin
  case StrToInt(EvType) of
    1: Dispose(PEvCellInputParams(Params));
    2: Dispose(PAfterTransmitParams(Params));
    3: Dispose(PEvCurPrepareParams(Params));
    4: Dispose(PEvPlugInParams(Params));
    5: Dispose(PEvAfterPasteParams(Params));
    6: Dispose(PEvOnRecalExtDataParams(Params));
  end;
  Params:=nil;
end;

procedure FreeRDBEventParams(var Event: TRDBEvent);
begin
  if Event.Params<>nil then
    DisposeEvParams(Event.Location.EvType,Event.Params);
end;

function RDBEventToVar(const Event: TRDBEvent): OleVariant;
begin
  Result:=VarArrayCreate([1,7],varVariant);
  Result[1]:=EvLocationToVar(Event.Location);
  Result[2]:=Event.Document;
  Result[3]:=Event.Table;
  Result[4]:=Event.Actions;
  Result[5]:=Event.Flags;
  Result[6]:=EvParamsToVar(Event.Location.EvType,Event.Params^);
  Result[7]:=Event.Custom;
end;

procedure VarToRDBEvent(const VarEvent: OleVariant; var Event: TRDBEvent);
begin
  VarToEvLocation(VarEvent[1],Event.Location);
  Event.Document:=IDispatch(VarEvent[2]) as IBook;
  Event.Table:=IDispatch(VarEvent[3]) as IRDBOLETable;
  Event.Actions:=VariantToString(VarEvent[4]);
  Event.Flags:=VarEvent[5];
  if Event.Params=nil then Event.Params:=NewEvParams(Event.Location.EvType);
  VarToEvParams(VarEvent[6],Event.Location.EvType,Event.Params^);
  Event.Custom:=VarEvent[7];
end;

function GetHandlerParamsOderLen(Params: PRDBHandlerParamInfo): integer;
var
  P: PRDBHandlerParamInfo;
begin
  Result:=0;
  P:=Params;
  while P<>nil do
    begin
      inc(Result);
      P:=P.NextParam;
    end;
end;

procedure DisposeHandlerParamsOder(var Params: PRDBHandlerParamInfo);
begin
  if Params<>nil then
    begin
      DisposeHandlerParamsOder(Params^.NextParam);
      Dispose(Params);
      Params:=nil;
    end;
end;

function HandlerParamInfoToVar(const Info: TRDBHandlerParamInfo): OleVariant;
begin
  with Info do
    Result:=VarArrayOf([ParamID,DataFormat,Style,Header,Caption,Hint,Default,ValList,Left,Top,Width,Height,Grid,Flags]);
end;

procedure VarToHandlerParamInfo(const VarInfo: OleVariant; var Info: TRDBHandlerParamInfo);
begin
  with Info do
    begin
      ParamID:=VariantToString(VarInfo[0]);
      DataFormat:=VarInfo[1];
      Style:=VarInfo[2];
      Header:=VariantToString(VarInfo[3]);
      Caption:=VariantToString(Varinfo[4]);
      Hint:=VariantToString(Varinfo[5]);
      Default:=VariantToString(VarInfo[6]);
      ValList:=VariantToString(VarInfo[7]);
      Left:=VarInfo[8];
      Top:=VarInfo[9];
      Width:=VarInfo[10];
      Height:=VarInfo[11];
      Grid:=VariantToString(VarInfo[12]);
      Flags:=VarInfo[13];
    end;
end;

function HandlerParamsOderToVar(HeadParam: PRDBHandlerParamInfo): OleVariant;
var
  L,i: integer;
  P: PRDBHandlerParamInfo;
begin
  if HeadParam<>nil then
    begin
      P:=HeadParam;
      L:=GetHandlerParamsOderLen(P);
      Result:=VarArrayCreate([1,L],varVariant);
      for i:=1 to L do
        begin
          Result[i]:=HandlerParamInfoToVar(P^);
          P:=P^.NextParam;
        end;
    end
      else
    Result:=NULL;
end;

function VarToHandlerParamsOder(const VarParams: OleVariant): PRDBHandlerParamInfo;
var
  L,H,i: integer;
  P: PRDBHandlerParamInfo;
begin
  if not(VarIsNULL(VarParams)) then
    begin
      L:=VarArrayLowBound(VarParams,1);
      H:=VarArrayHighBound(VarParams,1);
      New(Result);
      VarToHandlerParamInfo(VarParams[L],Result^);
      P:=Result;
      for i:=L+1 to H do
        begin
          New(P^.NextParam);
          P:=P^.NextParam;
          VarToHandlerParamInfo(VarParams[i],P^);
        end;
      P^.NextParam:=nil;
    end
      else
    Result:=nil;
end;

function HandlerInfoToVar(const Info: TRDBHandlerInfo): OleVariant;
begin
  Result:=VarArrayCreate([1,9],varVariant);
  Result[1]:=EvLocationToVar(Info.Location);
  Result[2]:=Info.Action;
  Result[3]:=Info.Name;
  Result[4]:=Info.Caption;
  Result[5]:=Info.Priority;
  Result[6]:=Info.Status;
  Result[7]:=Info.FormWidth;
  Result[8]:=Info.FormHeight;
  Result[9]:=HandlerParamsOderToVar(Info.ParamsInfo);
end;

procedure VarToHandlerInfo(const VarInfo: OleVariant; var Info: TRDBHandlerInfo);
begin
  VarToEvLocation(VarInfo[1],Info.Location);
  Info.Action:=VariantToString(VarInfo[2]);
  Info.Name:=VariantToString(VarInfo[3]);
  Info.Caption:=VariantToString(VarInfo[4]);
  Info.Priority:=VarInfo[5];
  Info.Status:=VarInfo[6];
  Info.FormWidth:=VarInfo[7];
  Info.FormHeight:=VarInfo[8];
  Info.ParamsInfo:=VarToHandlerParamsOder(VarInfo[9]);
end;

end.