Add(MainForm,2953706,91,161)
{
}
Add(StrMask,2673112,273,210)
{
 Mask="1122*"
 Point(doMask)
 link(onFalse,6933876:doOff,[])
 link(onTrue,6933876:doOn,[])
 link(Str,7057069:Var3,[(279,187)])
}
Add(Edit,13856812,168,84)
{
 Left=20
 Top=15
 Width=295
 Text="1122*"
 link(onChange,2673112:doMask,[(236,90)(236,223)])
}
Add(Edit,10757444,168,140)
{
 Left=20
 Top=55
 Width=295
 Text="112233"
}
Add(Button,12446957,91,210)
{
 Left=20
 Top=120
 link(onClick,4799450:doData,[])
}
Add(LED,6933876,364,203)
{
 Left=145
 Top=130
}
Add(DoData,4799450,168,210)
{
 link(onEventData,2673112:doCompare,[])
 link(Data,7057069:Var2,[])
}
Add(GetDataEx,7057069,168,182)
{
 link(Data,10757444:Text,[])
}

unit hiStrMask;

interface

uses Windows,Share,Debug;

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

    _data_Str:THI_Event;
    _event_onTrue:THI_Event;
    _event_onFalse:THI_Event;

    property _prop_Mask:string write SetMask;
    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
    UniqueString(str);
    CharLower(pointer(str));
  end;
  if _StrCmp(PChar(str),PChar(FMask)) then
    _Data.Next := @_event_onTrue;
end;

procedure THIStrMask._work_doMask;
begin
  _prop_Mask := Share.ToString(_Data);
end;

procedure THIStrMask.SetMask;
begin
  FMask := msk;
  if (_prop_CaseSensitive = 1) then begin
    UniqueString(FMask);
    CharLower(pointer(FMask));
  end;
end;

end.

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.

{$IFNDEF FPC}
type
  {$ifdef win64}
    NativeInt = Int64;
    NativeUInt = UInt64;
  {$else}
    NativeInt = Integer;
    NativeUInt = Cardinal;
  {$endif}
{$ENDIF}

Add(MainForm,9775816,294,175)
{
 Width=404
 Height=351
 Color=10789024
}
Add(Image,15497265,539,126)
{
 Left=5
 Top=5
 Width=385
 Height=275
}
Add(Button,10549840,294,133)
{
 Left=135
 Top=290
 Width=120
 TabOrder=-1
 Caption="Загрузить png"
 link(onClick,8644631:doEvent1,[])
}
Add(PNG,14345186,476,154)
{
 Point(doBitmap)
 link(onBitmap,15497265:doLoad,[(520,160)(520,132)])
}
Add(Hub,8644631,357,133)
{
 link(onEvent1,15497265:doClear,[])
 link(onEvent2,13387288:doExecute,[(381,146)(381,160)])
}
Add(Hub,11952692,441,154)
{
 link(onEvent1,14345186:doLoad,[])
 link(onEvent2,14345186:doBitmap,[(465,167)(465,174)])
}
Add(ODialog,13387288,392,154)
{
 Filter="Файлы *.png|*.png"
 link(onExecute,11952692:doEvent1,[])
}

function ArcTan2(const Y, X: Extended): Extended;
begin
  if X = 0 then
  begin
    if Y = 0 then
      Result := 0.0
    else if Y > 0 then
      Result := Pi/2
    else if Y < 0 then
      Result := -Pi/2;
  end
  else
    Result := ArcTan(Y/X);
  if X < 0.0 then
    Result := Result + Pi;
  if Result > Pi then
    Result := Result - 2*Pi;
end;