unit PASSBaseObj;  //Версия 1.4 от
// (С) Шуравин Александр www.easyprog.ru
interface
uses Classes,SysUtils,dialogs,Controls,Grids;

const CMaxBarCount=100000;
      CMaxValutesCount=12;
      CValutesEnum:array[1..CMaxValutesCount] of string[3]=('USD','EUR','CHF','GPB','JPY','AUD','CAD','NZD','DKK',
         'SGD','HKD','ATS');

type

  TBarStructure=record
     Open,Close,Hight,Low,Volume:real;
     DateTime:TDateTime;
  end;
  TPASSSignalsTypes=(enBuy, enSell);

  str6=string[6];
  str3=String[3];
  str5=String[5];


  TBufferArray=array[1..CMaxBarCount] of TBarStructure;
  PBufferArray=^TBufferArray;

  TBufferDoubleArray=array[1..CMaxBarCount] of double;
  PBufferDoubleArray=^TBufferDoubleArray;

  TPASSValutesDoubles=class(TObject)
     function GetPointerSize(ValutesDouble:str6):Integer;
  end;

  TPASSAbstractDataSource=Class(TObject)
  protected
    FFields:TStringList; // Список полей
    //FColumns:TStringList; //Список стобцов
  public
    Property Fields:TStringList Read FFields;
    //Property Columns:TStringList Read FColumns;
    function GetFieldNum(AFieldName:string):integer; // Получить поле по номеру
    destructor Destroy; override;
  end;

  TPASSDataSource=Class(TPASSAbstractDataSource)
  protected
    FActive:boolean;
    FCurrentItemIndex:LongInt;
    FCountLoadedBars:LongInt;
    procedure SetActive(AActive:boolean); virtual; abstract;
    procedure SetCurrentItemIndex(ACurrenItemIndex:LongInt); virtual; abstract;
  public
    Property Active:Boolean Read FActive Write SetActive;
    Property CurrentItemIndex:LongInt Read FCurrentItemIndex Write SetCurrentItemIndex;
    Property CountLoadedBars:LongInt read FCountLoadedBars;
    Function NextItem:boolean; virtual; abstract;
    Function PrevItem:boolean; virtual;  abstract;
    Procedure First; virtual; abstract;
    Procedure Last; virtual; abstract;
    Function GetDataByFieldName(AFieldName:String):Double; virtual;
    Function GetDataByFieldNum(AFieldNum:integer) :Double; virtual; abstract;
    Function GetDataByFieldNameAndIndex(AFieldName:String;Index:LongInt):Double; virtual;
    Function GetDataByFieldNumAndIndex(AFieldNum:integer;Index:LongInt):Double; virtual; abstract;
  end;

  TPASSBufferedDataSource=Class(TPASSDataSource)
  protected
    FBuffer:Pointer;
    FPointerSize:LongInt;
    procedure SetCurrentItemIndex(ACurrentItemIndex:LongInt); override;
  public
    Property PointerSize:LongInt Read FPointerSize Write FPointerSize;
    Function NextItem:boolean; override;
    Function PrevItem:boolean; override;
    Function Add:Boolean; virtual;
    Procedure First; override;
    Procedure Last; override;
    procedure FillGrid(AGrid:TStringGrid; AFields:TStringList); virtual;
  end;

  TPASSStreamBufferedDataSource=class(TPASSBufferedDataSource)
  protected
    procedure SaveHeader(AStream:TStream); virtual;
    procedure LoadHeader(AStream:TStream); virtual;
    function GetSignature:Str3; virtual; abstract;
    function GetVersion:real; virtual; abstract;
  end;

  TPASSStreamTimedBufferedDataSource=class(TPASSStreamBufferedDataSource)
  public
    function SearchIndexAsDate(ADateTime:TDateTime):integer;
  end;

  TPASSPriceSource=Class(TPASSStreamTimedBufferedDataSource)
  protected
    FFilePath:string;
    FTiker:string;
    FPeriod:string;
    FStream:TStream;
    FHaveHeader, FHaveTicker, FHavePer:boolean;
    FName:string;
    //FQuerySaveBeforeFree:boolean;
    procedure SetActive(AActive:boolean); override;
    procedure SetFilePath(AFilePath:string);
    function GetSignature:Str3; override;
    function GetVersion:real; override;
    procedure ShiftBufferRight(index,count:LongInt);
    procedure ShiftBufferLeft(index,count:LongInt);
  public
    property Name:string read FName write FName;
    property Active:Boolean Read FActive Write SetActive;
    constructor Create(AFilePath:string;AActive:boolean);
    property FilePath:string Read FFilePath Write SetFilePath;
    property Tiker:string read FTiker write FTiker;
    property Period:string read FPeriod;
    property Stream:TStream read FStream;
    //property QuerySaveBeforeFree:boolean read FQuerySaveBeforeFree write FQuerySaveBeforeFree;
    destructor Destroy; override;
    procedure SetBarData(ABarData:TBarStructure); virtual;
    function GetBarData:TBarStructure; virtual;
    function GetBarDataByIndex(Index:LongInt):TBarStructure; virtual;
    function GetDataByFieldNum(AFieldNum:integer) :Double; override;
    function GetDataByFieldNumAndIndex(AFieldNum:integer;Index:LongInt):Double; override;
    procedure LoadDataFromTextFile(AFilePath:string);
    procedure LoadBarFromTextFile(var AStruct:TBarStructure; var VF:TextFile);
    procedure LoadDataFromStream(AStream:TStream);
    procedure LoadBarFromStream(var AStruct:TBarStructure; AStream:TStream);
    procedure SaveDataToStream(AStream:TStream);
    procedure SaveBarToStream(AStruct:TBarStructure; AStream:TStream);
    procedure SaveBarToTextFile(var VF:TextFile; AStruct:tBarStructure);
    procedure SaveDataToTextFile(AFilePath:string);
    procedure SaveAllData;
    function  InsertBarData(ABarData:TBarStructure):boolean; virtual;
    procedure InsertEmptyBarBefore(index:LongInt); virtual;
    procedure Delete(index:LongInt);
  end;

  TParameterTypes=(ptFloat, ptData, ptSignal, ptString, ptInteger);

  TParameterStructure=record
     Name:string;
     Value:variant;
     ParameterType:TParameterTypes;
  end;

  PParameterStructure=^TParameterStructure;

  PPASSParameters=^TPASSParameters;
  TPASSParameters=Class(TList)
  private
    function Get(Index: Integer): PParameterStructure; virtual;
    procedure Put(Index: Integer; Item: PParameterStructure); virtual;
  public
    property Items[Index: Integer]: PParameterStructure read Get write Put; default;
    function GetParameterByName(ParameterName:string):Variant;
    procedure SetParameterByName(ParameterName:string; ParameterValue:Variant);
    function GetParameterByNum(ParameterNum:integer):Variant;
    procedure SetParameterByNum(ParameterNum:integer; ParameterValue:Variant);
    function Add(AParameterName:string; AParameterValue:variant; AType:TParameterTypes):integer;
    function AsString(ParameterName:string):string;
    function AsStringByNum(ParameterNum:integer):string;
    destructor Destroy;  override;
  end;



var
     VFLog:TextFile;

function GetToken(var StringVar:string; var Token:string):boolean;
function GetTokenSep(var StringVar:string; var Token:string; Sep:char):boolean;
function MyStrToFloat(StringVar:string):extended;
function DateTimeToSecDate(ADateTime:TDatetime):string;
function DateTimeToSecTime(ADateTime:TDatetime):string;
function PerPrToStr(APerPr:string):string;
function StrToPerPr(AStr:string):string;

implementation

function GetToken(var StringVar:string; var Token:string):boolean;
var i,l:byte;
begin
   L:=Length(StringVar);
   Token:='';
   for i:=1 to L do
     begin
       if StringVar[i]=',' then
         begin
            StringVar:=Copy(StringVar,i+1,L-i);
            Result:=true;
            exit;
         end;
       Token:=Token+StringVar[i];
     end;
   Result:=Token<>'';
end;

function GetTokenSep(var StringVar:string; var Token:string; Sep:char):boolean;
var i,l:byte;
begin
   L:=strLen(PChar(StringVar));
   Token:='';
   for i:=1 to L do
     begin
       if StringVar[i]=Sep then
         begin
            StringVar:=Copy(StringVar,i+1,L-i);
            Result:=true;
            exit;
         end;
       Token:=Token+StringVar[i];
     end;
   Result:=Token<>'';
end;


function MyStrToFloat(StringVar:string):extended;
var i,l:byte;
begin
   L:=Length(StringVar);
   for i:=1 to L do
       if StringVar[i]='.' then
            StringVar[i]:=',';
   Result:=StrToFloat(StringVar); // Не работает StrToFloat когда точка, надо запятую
end;

function DateTimeToSecDate(ADateTime:TDatetime):string;
var s:string; //11.11.1111
begin
  s:=Copy(DateTimeToStr(ADateTime),1,10);
  Result:=Copy(s,7,4)+copy(s,4,2)+copy(s,1,2);
end;

function DateTimeToSecTime(ADateTime:TDatetime):string;
var s,s1:string; l:Byte; //11.11.1111
begin
  s:=DateTimeToStr(ADateTime);
  L:=Length(s);
  s1:=Copy(s,L-7,8);
  Result:=copy(s1,1,2)+copy(s1,4,2)+Copy(s1,7,2);
end;


// *********  TPASSAbstractDataSource
destructor TPASSAbstractDataSource.Destroy;
begin
//  FColumns.Free;
  FFields.Free;
  inherited Destroy;
end;


function TPASSAbstractDataSource.GetFieldNum(AFieldName:string):integer;
var i,cn:integer;
begin
   cn:=FFields.Count-1;
   for i:=0 to cn do
     begin
        if AFieldName=FFields[i] then
          begin
            Result:=i;
            exit;
          end;
     end;
   raise Exception.Create('TPASSAbstractDataSource.GetFieldNum: поле '+
      AFieldName+' не найдено');
   Result:=-1;
end;

// ***** TPASSBufferedDataSource
procedure TPASSBufferedDataSource.FillGrid(AGrid: TStringGrid; AFields:TStringList);
var cn,i:integer;
begin
  AGrid.RowCount:=FCountLoadedBars;
  First;
  cn:=AFields.Count;
  while NextItem do for i := 1 to cn do
  begin
     if AFields[i-1]='DateTime' then
        AGrid.Cells[i,CurrentItemIndex-1]:=DateTimeToStr(GetDataByFieldName(AFields[i-1]))
     else
        AGrid.Cells[i,CurrentItemIndex-1]:=FloatToStr(GetDataByFieldName(AFields[i-1]));
  end;
end;

procedure TPASSBufferedDataSource.SetCurrentItemIndex(ACurrentItemIndex:LongInt);
begin
  FCurrentItemIndex:=ACurrentItemIndex;
end;

procedure TPASSBufferedDataSource.First;
begin
   FCurrentItemIndex:=1;
end;

procedure TPASSBufferedDataSource.Last;
begin
   FCurrentItemIndex:=FCountLoadedBars;
end;

function TPASSBufferedDataSource.NextItem:boolean;
begin
  if CurrentItemIndex<FCountLoadedBars then
     begin
       FCurrentItemIndex:=FCurrentItemIndex+1;
       Result:=true;
     end
     else Result:=false;
end;

function TPASSBufferedDataSource.PrevItem:boolean;
begin
  if CurrentItemIndex>0 then
     begin
       CurrentItemIndex:=CurrentItemIndex+1;
       Result:=true;
     end
     else Result:=false;
end;

function TPASSBufferedDataSource.Add:Boolean;
begin
//  Writeln(VFLog,'Data addition ',FCountLoadedBars);
  if FCountLoadedBars<CMaxBarCount then
     begin
       FCountLoadedBars:=FCountLoadedBars+1;
       FCurrentItemIndex:=FCountLoadedBars;
       Result:=true;
     end
     else Result:=false;
end;

// ***** TPASSPriceSource
constructor TPassPriceSource.Create(AFilePath:string;AActive:boolean);
begin
  Inherited Create;
  FFields:=TStringList.Create;
  FFields.Add('Open');
  FFields.Add('Close');
  FFields.Add('High');
  FFields.Add('Low');
  FFields.Add('Volume');
  FFields.Add('DateTime');

  {FColumns:=TStringList.Create;
  FColumns.Add('DateTime');
  FColumns.Add('Open');
  FColumns.Add('Close');
  FColumns.Add('High');
  FColumns.Add('Low');
  FColumns.Add('Volume');}

  FStream:=nil;
  GetMem(FBuffer,CMaxBarCount*Sizeof(TBarStructure));
  if FBuffer=nil then Raise Exception.Create('TPassPriceSource.Create: Ошибка выделения памяти');
  FFilePath:=AFilePath;// Путь к файлу присваиваем полю напрямую - ничего делать не надо
  Active:=AActive; // А вот ту присваивам свойству - надо загрузить файл,
                   // если объект делаем активным
end;

function TPASSPriceSource.GetSignature:str3;
begin
  Result:='@#%';
end;

function TPASSPriceSource.GetVersion:real;
begin
  Result:=1.1;
end;


procedure TPASSPriceSource.SaveDataToStream(AStream:TStream);
var I:LongInt;
begin
  SaveHeader(AStream);
  for I:=1 to FCountLoadedBars do SaveBarToStream(PBufferArray(FBuffer)^[I], AStream);
end;

procedure TPASSPriceSource.LoadDataFromStream(AStream:TStream);
var I:LongInt;
begin
  LoadHeader(AStream);
  for I:=1 to FCountLoadedBars do LoadBarFromStream(PBufferArray(FBuffer)^[I], AStream);
end;

procedure TPASSPriceSource.LoadBarFromStream(var AStruct:TBarStructure; AStream:TStream);
begin
   AStream.Read(AStruct,Sizeof(AStruct));
end;

procedure TPASSPriceSource.SaveBarToStream(AStruct:TBarStructure; AStream:TStream);
begin
  AStream.Write(AStruct,SizeOf(AStruct));
end;

procedure TPASSPriceSource.SaveAllData;
begin
  FStream.Position:=0;
  SaveDataToStream(FStream);
end;

procedure TPASSPriceSource.LoadBarFromTextFile(var AStruct:TBarStructure; var VF:TextFile);
var CurStr,DateStr,TimeStr,Token,s:string;
begin
  if FCurrentItemIndex>CMaxBarCount then
      Raise ERangeError.CreateFmt(
        'Количество баров не может превышать %d',
          [CMaxBarCount]);
  System.Readln(VF,CurStr);
  if (CurStr='') or (CurStr[1]=' ') then Exit;
  if CurStr[1]='<' then
  begin
     FHaveHeader:=true;
     GetToken(CurStr,s);
     if s='<TICKER>' Then FHaveTicker:=True;
     GetToken(CurStr,s);
     if s='<PER>' Then FHavePer:=True;
     Exit;
  end;
  if FHaveHeader then
    begin
       if FHaveTicker then GetToken(CurStr,FTiker);
       if FHavePer then GetToken(CurStr,FPeriod);
    end;
  GetToken(CurStr,DateStr);
  GetToken(CurStr,TimeStr);
  if DateStr[3]<>'.' then
    begin
      if DateStr[5]<>'.' then
        begin
          s:=Copy(DateStr,7,2)+'.'+Copy(DateStr,5,2)+'.'+Copy(DateStr,1,4);
          DateStr:=s;
          s:=Copy(TimeStr,1,2)+':'+Copy(TimeStr,3,2)+':'+Copy(TimeStr,5,2);
          TimeStr:=s;
        end else
        begin
          s:=Copy(DateStr,9,2)+'.'+Copy(DateStr,6,2)+'.'+Copy(DateStr,1,4);
          DateStr:=s;
        end;
     end;
  AStruct.DateTime:=StrToDateTime(DateStr+' '+TimeStr);
  GetToken(CurStr,Token);
  AStruct.Open:=MyStrToFloat(Token);
  GetToken(CurStr,Token);
  AStruct.Hight:=MyStrToFloat(Token);
  GetToken(CurStr,Token);
  AStruct.Low:=MyStrToFloat(Token);
  GetToken(CurStr,Token);
  AStruct.Close:=MyStrToFloat(Token);
  GetToken(CurStr,Token);
  AStruct.Volume:=MyStrToFloat(Token);
end;

procedure TPASSPriceSource.LoadDataFromTextFile(AFilePath:string);
var VarFileText:TextFile;
begin
  System.AssignFile(VarFileText,AFilePath);
  System.Reset(VarFileText);
  FCurrentItemIndex:=0;
  FHaveHeader:=False;
  FHaveTicker:=False;
  FHavePer:=False;
  FTiker:='';
  FPeriod:='';
  while not System.Eof(VarFileText) do
    begin
      FCurrentItemIndex:=FCurrentItemIndex+1;
      LoadBarFromTextFile(PBufferArray(FBuffer)^[FCurrentItemIndex], VarFileText);
    end;
  System.CloseFile(VarFileText);
  FCountLoadedBars:=FCurrentItemIndex;
end;

procedure TPASSPriceSource.SetActive(AActive:boolean);
var FD:TSaveDialog;
begin
  if FActive=AActive then exit;
  FActive:=AActive;
  if FStream<>nil then
  begin
    FStream.Free;
    FStream:=nil;
  end;
  if FFilePath='' then begin
    FD:=TSaveDialog.Create(nil);
    while not(FD.Execute) do MessageDlg('Выберите файл',mtError,[mbOK],0);
    FD.FileEditStyle:=fsEdit;
    FD.Filter:='Файлы данных|*.dat';
    FFilePath:=FD.FileName;
  end;
  if Active then if FileExists(FFilePath) then
    begin
      FStream:=TFileStream.Create(FFilePath,fmOpenReadWrite);
      LoadDataFromStream(FStream);
    end else
    begin
      FStream:=TFileStream.Create(FFilePath,fmCreate);
      if FCountLoadedBars<>0 then SaveAllData;
    end;
end;


procedure TPASSPriceSource.SetFilePath(AFilePath:String);
begin
  if FActive then Raise Exception.Create('Нельзя изменить файл активного источника котировок');
  FFilePath:=AFilePath;
end;

procedure TPASSPriceSource.ShiftBufferRight(index,count:LongInt);
var i:LongInt;
begin
   if FCountLoadedBars+count>CMaxBarCount then
       raise Exception.Create(
       'TPASSPriceSource.ShiftBufferRight - выход за границы массива');
   FCountLoadedBars:=FCountLoadedBars+Count;
   for i:=FCountLoadedBars downto index do PBufferArray(FBuffer)^[i]:=PBufferArray(FBuffer)^[i-count];
end;

procedure TPASSPriceSource.ShiftBufferLeft(index,count:LongInt);
var i:LongInt;
begin
   if Index-count<0 then
       raise Exception.Create(
       'TPASSPriceSource.ShiftBufferRight - выход за границы массива');
   for i:=index to FCountLoadedBars do
    begin
      PBufferArray(FBuffer)^[i]:=PBufferArray(FBuffer)^[i+count];
    end;
   FCountLoadedBars:=FCountLoadedBars-Count;
end;


function TPASSDataSource.GetDataByFieldName(AFieldName:string):Double;
begin
   Result:=GetDataByFieldNum(GetFieldNum(AFieldName));
end;

function TPASSPriceSource.GetBarData:TBarStructure;
begin
   Result:=PBufferArray(FBuffer)^[FCurrentItemIndex];
end;

function TPASSPriceSource.GetBarDataByIndex(index:LongInt):TBarStructure;
begin
   if (index<1) or (index>FCountLoadedBars) then
      raise Exception.Create('TPASSPriceSource.GetBarDataByIndex index за предалми значений '+IntToStr(index));
   Result:=PBufferArray(FBuffer)^[Index];
end;


procedure TPASSPriceSource.SetBarData(ABarData:TBarStructure);
begin
   PBufferArray(FBuffer)^[FCurrentItemIndex]:=ABarData;
end;

procedure TPASSPriceSource.SaveDataToTextFile(AFilePath:string);
var VF:TextFile; I:LongInt;
begin
  AssignFile(VF,AFilePath);
  Rewrite(VF);
  for I:=1 to FCountLoadedBars do SaveBarToTextFile(VF, PBufferArray(FBuffer)^[I]);
  CloseFile(VF);
end;

procedure TPASSPriceSource.SaveBarToTextFile(var VF:TextFile; AStruct:TBarStructure);
var s:string; Frm:TFormatSettings;
begin
  s:='';
  if FTiker<>'' then s:=s+FTiker+',';
  if FPeriod<>'' then s:=s+FPeriod+',';
  s:=s+DateTimeToSecDate(AStruct.DateTime)+',';
  s:=s+DateTimeToSecTime(AStruct.DateTime)+',';
  Write(VF,s);
  frm.DecimalSeparator:='.';
  frm.CurrencyDecimals:=4;
  Write(VF,FloatToStr(AStruct.Open,frm),',');
  Write(VF,FloatToStr(AStruct.Hight,frm),',');
  Write(VF,FloatToStr(AStruct.Low,frm),',');
  Write(VF,FloatToStr(AStruct.Close,frm),',');
  Write(VF,FloatToStr(AStruct.Volume,frm),',');
  WriteLn(VF,0);
end;

function TPASSPriceSource.GetDataByFieldNum(AFieldNum:integer):Double;
begin
   case AFieldNum of
      0:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].Open;
      1:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].Close;
      2:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].Hight;
      3:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].Low;
      4:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].Volume;
      5:Result:=PBufferArray(FBuffer)^[FCurrentItemIndex].DateTime;
   else raise Exception.Create('TPASSPriceSource.GetDataByFieldNum - неверный номер поля: '+IntToStr(AFieldNum));
   end;
end;

function  TPASSDataSource.GetDataByFieldNameAndIndex(AFieldName:string;Index:LongInt):Double;
begin
   Result:=GetDataByFieldNumAndIndex(GetFieldNum(AFieldName),Index);
end;

function TPASSPriceSource.GetDataByFieldNumAndIndex(AFieldNum:integer;Index:LongInt):Double;
begin
   case AFieldNum of
      0:Result:=PBufferArray(FBuffer)^[Index].Open;
      1:Result:=PBufferArray(FBuffer)^[Index].Close;
      2:Result:=PBufferArray(FBuffer)^[Index].Hight;
      3:Result:=PBufferArray(FBuffer)^[Index].Low;
      4:Result:=PBufferArray(FBuffer)^[Index].Volume;
      5:Result:=PBufferArray(FBuffer)^[Index].DateTime;
   else raise ERangeError.Create('GetDataByFieldNumAndIndex - неверный индекс поля');
   end;
end;


function  TPASSPriceSource.InsertBarData(ABarData:TBarStructure):boolean;
var sr:integer;
begin
   if CountLoadedBars=CMaxBarCount then
   begin
     Result:=false;
     exit;
   end else Result:=true;
   sr:=SearchIndexAsDate(ABarData.DateTime);
   case sr of
      1:PBufferArray(FBuffer)^[FCurrentItemIndex]:=ABarData;
      -1:begin
           InsertEmptyBarBefore(FCurrentItemIndex);
           PBufferArray(FBuffer)^[FCurrentItemIndex]:=ABarData;
         end;
      0:begin
           Add;
           PBufferArray(FBuffer)^[FCurrentItemIndex]:=ABarData;
        end;
   end;
end;

procedure  TPASSPriceSource.InsertEmptyBarBefore(index:LongInt);
begin
   ShiftBufferRight(index,1);
end;

procedure  TPASSPriceSource.delete(index:LongInt);
begin
   ShiftBufferLeft(index,1);
end;


destructor TPASSPriceSource.Destroy;
var FD:TSaveDialog;
begin
 if FFilePath='' then
   if MessageDlg(FName+' '+FTiker+' '+PerPrToStr(FPeriod)+
       ' Сохранить данные?',mtConfirmation,
          [mbYes,mbNo],0)=mrYes then
    begin
       FD:=TSaveDialog.Create(nil);
       if FD.Execute then begin
          FD.FileEditStyle:=fsEdit;
          FD.Filter:='Файлы данных|*.dat';
          FFilePath:=FD.FileName;
          if FStream<>nil then
              begin
                 FStream.Free;
                 FStream:=nil;
              end;
          FStream:=TFileStream.Create(FFilePath,fmCreate);
       end else begin
         if FStream<>nil then FStream.Free;
         FStream:=nil;
       end;
    end else begin
       if FStream<>nil then FStream.Free;
       FStream:=nil;
    end;
  if FStream<>nil then SaveAllData;
  if FStream<>nil then
  begin
     FStream.Free;
     FStream:=nil;
  end;
  FreeMem(FBuffer,CMaxBarCount*Sizeof(TBarStructure));
  inherited Destroy;
end;

// *********** TPASSParameters *********

procedure TPASSParameters.Put(Index: Integer; Item: PParameterStructure);
begin
  inherited Put(index,Item);
end;

function TPASSParameters.Get(Index:integer):PParameterStructure;
begin
  {MessageDlg('Is Get',mtInformation,[mbOK],0);}
  Result:=inherited Get(Index);
end;

function TPASSParameters.GetParameterByName(ParameterName:string):variant;
var i,cn:integer;
begin
   cn:=Count-1;
   Result:='';
   for i:=0 to cn do
     if Items[i]^.Name=ParameterName then
       begin
         Result:=Items[i]^.Value;
         exit;
       end;
end;

procedure TPASSParameters.SetParameterByName(ParameterName:string; ParameterValue:Variant);
var i,cn:integer;
begin
   cn:=Count-1;
   for i:=0 to cn do
     if Items[i]^.Name=ParameterName then
       begin
         Items[i]^.Value:=ParameterValue;
         exit;
       end;
   raise Exception.Create('TPASSParameters.SetParameterByName - параметр '+ParameterName+' не найден');
end;

function TPASSParameters.GetParameterByNum(ParameterNum:integer):variant;
begin
  Result:=Items[ParameterNum]^.Value;
end;

procedure TPASSParameters.SetParameterByNum(ParameterNum:integer; ParameterValue:Variant);
begin
  Items[ParameterNum]^.Value:=ParameterValue;
end;

function TPassParameters.Add(AParameterName:string; AParameterValue:variant; AType:TParameterTypes):integer;
var AParameterStructure:PParameterStructure;
begin
  new(AParameterStructure);
  AParameterStructure^.Name:=AParameterName;
  AParameterStructure^.Value:=AParameterValue;
  AParameterStructure^.ParameterType:=AType;
  result:=inherited Add(AParameterStructure);
end;

function TPassParameters.AsString(ParameterName:string):string;
var i,cn:integer;
begin
   cn:=Count-1;
   Result:='';
   for i:=0 to cn do
     if Items[i]^.Name=ParameterName then
       begin
         Result:=AsStringByNum(i);
         exit;
       end;
end;

function TPassParameters.AsStringByNum(ParameterNum:integer):string;
var tmp:PParameterStructure;
begin
  tmp:=Items[ParameterNum];
  case tmp.ParameterType of
    ptFloat:result:=FloatToStr(tmp.Value);
    ptData:result:=DateTimeToStr(tmp.Value);
    ptSignal:if tmp.Value=enBuy then result:='Buy' else Result:='Sell';
    ptString:result:=tmp.Value;
    ptInteger:result:=IntToStr(tmp.Value);
  end;
end;


destructor TPassParameters.Destroy;
var i,cn:integer;
begin
  cn:=Count-1;
  for i:=1 to cn do  Dispose(Items[i]);
  inherited Destroy;
end;


function TPASSValutesDoubles.GetPointerSize(ValutesDouble:str6):integer;
var Valuta1,Valuta2:string[3]; CodValuta1,CodValuta2:byte;
i:byte;
begin
   Valuta1:=Copy(ValutesDouble,1,3);
   Valuta2:=Copy(ValutesDouble,4,3);
   CodValuta1:=0;
   CodValuta2:=0;
   Result:=0;
   for i:=1 to CMaxValutesCount do
      if Valuta1=CValutesEnum[i] then
         begin
           CodValuta1:=i;
           break;
         end;
   for i:=1 to CMaxValutesCount do
      if Valuta2=CValutesEnum[i] then
         begin
           CodValuta2:=i;
           break;
         end;
   case CodValuta1 of
      1:case CodValuta2 of
         3:Result:=10000;  //USDCHF
         4:Result:=10000;  //USDGPB
         5:Result:=100;    //USDJPY
      end;
      2: case CodValuta2 of
         1:Result:=10000;  //EURUSD
         3:Result:=10000;  //EURCHF
         4:Result:=10000;  //EURGPB
         5:Result:=100;    //EURJPY
      end;
      4:case CodValuta2 of
         1:Result:=10000; //GPBUSD
         3:Result:=10000; //GPBCHF
         5:Result:=100;   //GPBJPY
      end;
  end;
  if Result=0 then Raise Exception.Create('Invalid valutes double '+ValutesDouble);
{'USD','EUR','CHF','GPB','JPY','AUD','CAD','NZD','DKK',
         'SGD','HKD','ATS');}
end;

// ******************* TPASSStreamBufferedDataSource ***********

procedure TPASSStreamBufferedDataSource.SaveHeader(AStream:TStream);
Var Signature:str3;
    Version:real;
begin
   Signature:=GetSignature;
   Version:=GetVersion;
   AStream.Write(Signature,SizeOf(Signature));
   AStream.Write(Version,SizeOf(Version));
   AStream.Write(FCountLoadedBars,SizeOf(FCountLoadedBars));
end;

procedure TPASSStreamBufferedDataSource.LoadHeader(AStream:TStream);
Var Signature:str3;
    Version:real;
begin
  AStream.Read(Signature,Sizeof(Signature));
  if GetSignature<>Signature then Raise Exception.Create('TPASSPriceSource.LoadHeader: неверный формат файла');
  AStream.Read(Version,Sizeof(Version));
  if Version>GetVersion then
     Raise Exception.Create(
     'TPASSPriceSource.LoadHeader: нельзя открыть файл версии '+
     FloatToStr(Version)+' в модуле PASSBaseObj версии '+
     FloatToStr(GetVersion));
  AStream.Read(FCountLoadedBars,Sizeof(FCountLoadedBars));
end;

// ******************** GLOBALS

function PerPrToStr(APerPr:string):string;
begin
  Result:='Неизвестный период';
  if APerPr='M' then Result:='Месяц';
  if APerPr='W' then Result:='Неделя';
  if APerPr='D' then Result:='День';
  if APerPr='60' then Result:='Час';
  if APerPr='30' then Result:='30 мин.';
  if APerPr='15' then Result:='15 мин.';
  if APerPr='10' then Result:='10 мин.';
  if APerPr='5' then Result:='5 мин.';
  if APerPr='1' then Result:='1 мин.';
  if APerPr='0' then Result:='Тик';
end;

function StrToPerPr(AStr:string):string;
begin
  Result:='Неизвестный период';
  if AStr='Месяц' then Result:='M';
  if AStr='Неделя' then Result:='W';
  if AStr='День' then Result:='D';
  if AStr='Час' then Result:='60';
  if AStr='30 мин.' then Result:='30';
  if AStr='15 мин.' then Result:='15';
  if AStr='10 мин.' then Result:='10';
  if AStr='5 мин.' then Result:='5';
  if AStr='1 мин.' then Result:='1';
  if AStr='Тик' then Result:='0';
end;

// ************* TPASSStreamTimedBufferedDataSource

function TPASSStreamTimedBufferedDataSource.SearchIndexAsDate(ADateTime:TDateTime):integer;
var s:string;
begin
  Result:=1;
  First;
  repeat
    s:=FloatToStr(GetDataByFieldName('DateTime'));
    if PBufferArray(FBuffer)^[FCurrentItemIndex].DateTime=ADateTime then exit;
    if PBufferArray(FBuffer)^[FCurrentItemIndex].DateTime>ADateTime then
    begin
      Result:=-1;
      exit;
    end;
  until Not NextItem;
  Result:=0;
end;


end.

