Measure/Units/mPegFilter.pas

unit mPegFilter;

interface

uses
  Classes, SysUtils, PerlRegEx;

type
  // analyse Peg Num
  // YK1+000 --> K1+000
  TPegFilter = class
  private
    FBeginPeg: string;
    FBeginPegNum: Double;
    FEndPeg: string;
    FEndPegNum: Double;

    function PegFormat(const AStr: string): string;
    function FilterPeg(const AStr: string; var APeg: string; var ANum: Double; var ABegin, AEnd: Integer): Boolean;
  public
    function Filter(const AStr: string): Boolean;

    property BeginPeg: string read FBeginPeg;
    property BeginPegNum: Double read FBeginPegNum;
    property EndPeg: string read FEndPeg;
    property EndPegNum: Double read FEndPegNum;
  end;

  // filter begin/end Peg, keep orginal Peg
  // GLK1+000 --> GLK1+000
  TPegInfo = class
    FPeg: string;
    FOffset: Integer;
    FLength: Integer;
  end;

  TPegStrFilter = class
  private
    FToRegStr: string;
    FPegRegStr: string;
    FPegStr: string;

    FPegList: TList;
    FBeginPegList: TList;
    FEndPegList: TList;

    procedure ClearHistory;
    procedure FilterPeg;
    procedure FilterBeginAndEnd;
    procedure AnalysePeg;

    function MergePeg(Pegs: TList): string;

    procedure SetPegStr(const Value: string);
    function GetBeginPeg: string;
    function GetEndPeg: string;
    function GetSubPegCount: Integer;
    function GetSubPeg(AIndex: Integer): string;
  public
    constructor Create;
    destructor Destory;

    property PegRegStr: string read FPegRegStr;
    property ToRegStr: string read FToRegStr;

    property PegStr: string read FPegStr write SetPegStr;
    property BeginPeg: string read GetBeginPeg;
    property EndPeg: string read GetEndPeg;
    property SubPegCount: Integer read GetSubPegCount;
    property SubPeg[AIndex: Integer]: string read GetSubPeg;
  end;

function PegFilter: TPegFilter;

implementation

uses Math, ZhAPI;

var
  FPegFilter: TPegFilter;

function PegFilter: TPegFilter;
begin
  if FPegFilter = nil then
    FPegFilter := TPegFilter.Create;
  Result := FPegFilter;
end;

{ TPegFilter }

function TPegFilter.Filter(const AStr: string): Boolean;
var
  sPeg: string;
  iPos, iBegin, iEnd: Integer;
begin
  sPeg := PegFormat(AStr);
  Result := FilterPeg(sPeg, FBeginPeg, FBeginPegNum, iBegin, iEnd);
  if Result and (sPeg[iEnd+1] = '~') then
  begin
    sPeg := StringReplace(sPeg, FBeginPeg, '', []);
    FilterPeg(sPeg, FEndPeg, FEndPegNum, iBegin, iEnd);
    if FEndPegNum = 0 then
    begin
      FEndPeg := FBeginPeg;
      FEndPegNum := FBeginPegNum;
    end
    else
      Result := FEndPegNum >= FBeginPegNum;
  end
  else
  begin
    FEndPeg := '';
    FEndPegNum := 0;
  end;
end;

function TPegFilter.FilterPeg(const AStr: string; var APeg: string;
  var ANum: Double; var ABegin, AEnd: Integer): Boolean;

  function FilterInt(ABegin: Integer; var AEnd: Integer; var AIntStr: string; var AValue: Integer): Boolean;
  var
    iPos, iLength: Integer;
    sInt: string;
  begin
    AIntStr := '';
    AEnd := ABegin;

    iPos := ABegin;
    iLength := Length(AStr);
    while (iPos <= iLength) do
    begin
      if AStr[iPos] in ['0'..'9'] then
      begin
        AIntStr := AIntStr + AStr[iPos];
        AEnd := iPos;
      end
      else Break;
      Inc(iPos);
    end;

    Result := AIntStr <> '';
    AValue := StrToIntDef(AIntStr, 0);
  end;

  // 过滤一个小于1000的Float
  function FilterFloat(ABegin: Integer; var AEnd: Integer; var AFloatStr: string; var AValue: Double): Boolean;
  var
    iPos, iLength, iIntPartLength: Integer;
    bHasPoint, bAllZero: Boolean;
  begin
    AFloatStr := '';
    AEnd := ABegin;

    iPos := ABegin;
    iLength := Length(AStr);
    bHasPoint := False;
    bAllZero := True;
    iIntPartLength := 0;
    while (iPos <= iLength) do
    begin
      if AStr[iPos] in ['0'..'9'] then
      begin
        AFloatStr := AFloatStr + AStr[iPos];
        AEnd := iPos;
        if not bHasPoint then
          Inc(iIntPartLength);

        bAllZero := bAllZero and (AStr[iPos] = '0');
      end
      else if (AStr[iPos] = '.') and (not bHasPoint) then
      begin
        AFloatStr := AFloatStr + AStr[iPos];
        AEnd := iPos;
        bHasPoint := True;
      end
      else Break;
      Inc(iPos);
    end;

    if iIntPartLength > 3 then
    begin
      AEnd := ABegin + 3 - 1;
      AFloatStr := Copy(AFloatStr, 1, 3);
    end;

    AValue := StrToFloatDef(AFloatStr, 0);
    Result := (AValue <> 0) or (bAllZero and (AEnd > ABegin));
  end;

var
  iPos, iLength: Integer;
  iBeginNum, iEndNum, iPosPuls, iBeginNum2, iEndNum2: Integer;
  sNum, sNum2: string;
  iNum: Integer;
  fNum: Double;
begin
  Result := False;
  APeg := '';
  ANum := 0;
  ABegin := -1;
  AEnd := -1;

  iPos := 1;
  iLength := Length(AStr);
  while (iPos <= iLength) and (not Result) do
  begin
    if AStr[iPos] = 'k' then
    begin
      iBeginNum := iPos + 1;
      if FilterInt(iBeginNum, iEndNum, sNum, iNum) then
      begin
        iPosPuls := iEndNum + 1;
        if AStr[iPosPuls] = '+' then
        begin
          iBeginNum2 := iPosPuls + 1;
          if FilterFloat(iBeginNum2, iEndNum2, sNum2, fNum) then
          begin
            Result := True;
            APeg := Copy(AStr, iPos, iEndNum2-iPos+1);
            ANum := iNum * 1000 + fNum;
            ABegin := iPos;
            AEnd := iEndNum2;
          end;
        end;
      end
    end;
    inc(iPos);
  end;
end;

function TPegFilter.PegFormat(const AStr: string): string;
begin
  Result := AStr;
  Result := StringReplace(Result, 'K', 'k', [rfReplaceAll]);
  Result := StringReplace(Result, '＋', '+', [rfReplaceAll]);
  Result := StringReplace(Result, '－', '-', [rfReplaceAll]);
  Result := StringReplace(Result, '～', '~', [rfReplaceAll]);
  Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
end;

{ TPegStrFilter }

procedure TPegStrFilter.AnalysePeg;
begin
  ClearHistory;
  FilterPeg;
  FilterBeginAndEnd;
end;

procedure TPegStrFilter.ClearHistory;
begin
  ClearObjects(FPegList);
  FPegList.Clear;
  FBeginPegList.Clear;
  FEndPegList.Clear;
end;

constructor TPegStrFilter.Create;
begin
  FPegRegStr := '[a-zA-z]{0,2}[kK]\d+[+＋][0-9.]+';
  FToRegStr := '[-－~～]';

  FPegList := TList.Create;
  FBeginPegList := TList.Create;
  FEndPegList := TList.Create;
end;

destructor TPegStrFilter.Destory;
begin
  FEndPegList.Free;
  FBeginPegList.Free;
  ClearObjects(FPegList);
  FPegList.Free;
end;

procedure TPegStrFilter.FilterBeginAndEnd;
var
  vToReg: TPerlRegEx;
  vPeg1, vPeg2: TPegInfo;
  i, iPos: Integer;
begin
  vToReg := TPerlRegEx.Create;
  vToReg.RegEx := FToRegStr;
  if FPegList.Count > 0 then
  begin
    for i := 1 to FPegList.Count - 1 do
    begin
      iPos := i;
      vPeg1 := TPegInfo(FPegList.Items[i - 1]);
      vPeg2 := TPegInfo(FPegList.Items[i]);
      vToReg.Subject := Copy(FPegStr, vPeg1.FOffSet + vPeg1.FLength, vPeg2.FOffSet - (vPeg1.FOffSet + vPeg1.FLength));
      if vToReg.Match then
        Break;
    end;

    for i := 0 to FPegList.Count - 1 do
    begin
      if i < iPos then
        FBeginPegList.Add(FPegList.Items[i])
      else
        FEndPegList.Add(FPegList.Items[i]);
    end;
  end;
  vToReg.Free;
end;

procedure TPegStrFilter.FilterPeg;
var
  vPegReg: TPerlRegEx;
  vPegInfo: TPegInfo;
begin
  vPegReg := TPerlRegEx.Create;
  vPegReg.Subject := PegStr;
  vPegReg.RegEx := PegRegStr;
  while vPegReg.MatchAgain do
  begin
    vPegInfo := TPegInfo.Create;
    vPegInfo.FPeg := vPegReg.MatchedText;
    vPegInfo.FOffset := vPegReg.MatchedOffset;
    vPegInfo.FLength := vPegReg.MatchedLength;
    FPegList.Add(vPegInfo);
  end;
  vPegReg.Free;
end;

function TPegStrFilter.GetBeginPeg: string;
begin
  Result := MergePeg(FBeginPegList);
end;

function TPegStrFilter.GetEndPeg: string;
begin
  if FEndPegList.Count > 0 then
    Result := MergePeg(FEndPegList)
  else
    Result := MergePeg(FBeginPegList);
end;

function TPegStrFilter.GetSubPeg(AIndex: Integer): string;
begin
  if (AIndex < 0) or (AIndex >= SubPegCount) then
    Result := ''
  else
    Result := TPegInfo(FPegList.Items[AIndex]).FPeg;
end;

function TPegStrFilter.GetSubPegCount: Integer;
begin
  Result := FPegList.Count;
end;

function TPegStrFilter.MergePeg(Pegs: TList): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Pegs.Count - 1 do
  begin
    if i = 0 then
      Result := TPegInfo(Pegs.Items[i]).FPeg
    else
      Result := Result + '/' + TPegInfo(Pegs.Items[i]).FPeg;
  end;
end;

procedure TPegStrFilter.SetPegStr(const Value: string);
begin
  FPegStr := Value;
  AnalysePeg;
end;

initialization
  FPegFilter := nil;
finalization
  FPegFilter.Free;
end.