Вверх ↑
Ответов: 207
Рейтинг: 14
#1: 2021-01-23 02:06:44 ЛС | профиль | цитата
Rysik, Проблемы были в предыдущей версии. В FPC 3.2.0 все норм уже.
Вот hiStrMask.pas

unit hiStrMask;

interface

uses
  Windows, KOL, Share, Debug;

type
  THIStrMask = class(TDebug)
    private
      FMask: string;
      procedure SetMask(Value: string);
    public
      _prop_CaseSensitive: Byte;

      _data_Str: THI_Event;
      _event_onTrue: THI_Event;
      _event_onFalse: THI_Event;
      
      property _prop_Mask: string write SetMask; // —войство Mask должно сто¤ть последним в ini!

      procedure _work_doCompare(var _Data: TData; Index: Word);
      procedure _work_doMask(var _Data: TData; Index: Word);
  end;

function StrCmp(Str, Msk: string): Boolean;

implementation

function _StrCmp(Str, Msk: PChar): Boolean;
begin
  while (Str^ <> #0) and (Msk^ <> #0) do
  begin
    if Msk^ = '*' then
    begin
      Result := _StrCmp(Str, Msk + 1);
      if Result then Exit;
    end
    else
    begin
      if Msk^ = '#' then
        Result := Str^ in ['0'..'9']
      else
        Result := (Msk^ = '?') or (Msk^ = Str^);
      
      if Result then
        Inc(Msk)
      else
        Exit;
    end;
    
    Inc(Str);
  end;
  
  while Msk^ = '*' do Inc(Msk);
  
  Result := (Str^ = #0) and (Msk^ = #0);
end;

function StrCmp(Str, Msk: string): Boolean;
begin
  Result := _StrCmp(PChar(Str), PChar(Msk));
end;

procedure THIStrMask._work_doCompare;
var
  Str: string;
begin
  Str := ReadString(_Data, _data_Str);
  _hi_CreateEvent(_Data, @_event_onFalse, Str);
  
  if (_prop_CaseSensitive = 1) then
  begin
    Str := AnsiLowerCase(Str);
  end;
  
  if _StrCmp(PChar(Str), PChar(FMask)) then
    _Data.Next := @_event_onTrue;
end;

procedure THIStrMask._work_doMask;
begin
  SetMask(Share.ToString(_Data));
end;

procedure THIStrMask.SetMask(Value: string);
begin
  FMask := Value;
  if (_prop_CaseSensitive = 1) then
    FMask := AnsiLowerCase(FMask);
end;

end.

карма: 2

0