unit winutl;

interface
uses
  SysUtils, Classes;

procedure MemFree(var P{:pointer});
  { tries to free memory allocated to P (if P <> nil), then sets it = nil }
procedure ClassFree(var P{:TObject});
  { tries to call P.Free (if P <> nil), then assigns P = nil }

procedure StreamWriteln(AStream: TStream; const AString: shortstring);
function StreamReadln(AStream: TStream; var AString: shortstring): boolean;

function GetExtFromFileDialogFilter(const AFilter: string; AIndex: integer): string;
  { extracts from Save or OpenDialog's Filter property extension that corresponds
    to AIndex }
{v0.16}
function GetDialogFilterIndexFromExt(const AFilter: string; const AExt: string; var AIndex: integer):boolean;
  { finds out what is the index of the extension AExt in the AFilter (property
    of Save/OpenDialog component). AExt is e.g.:  .TXT  Returns false if the ext not
    found }
{/v0.16}

function FixDecSep(const s: string): string;
  { replaces all decimal separator chars "," or "." with the one specified
    in SysUtils unit, so that the resulting number won't generate exception
    upon submiting it to SysUtils. StrToInt or StrToFloat functions }

{v0.13}
function RelativeFileName(const ADir: string; const AFileName: TFileName): TFileName;
  { Returns filename stripped of specified (or current, if ADir = '')
    directory, if present. }
{/v0.13}

implementation

const
  CrLf:array[0..1]of char = (#13,#10);

procedure StreamWriteln(AStream: TStream; const AString: shortstring);
begin
  AStream.WriteBuffer(AString[1], length(AString));
  AStream.WriteBuffer(CrLf, length(CrLf));
end;

function StreamReadln(AStream: TStream; var AString: shortstring): boolean;
var ch:char;
begin
  AString := '';
  Result := true;
  repeat
    if AStream.Read(ch, 1) = 1 then begin
      case ch of
        #13:;
        #10: break;
      else
        AString := AString + ch;
      end;
    end else begin
      if AString = '' then
        Result := false;
      break;
    end;
  until false;
end;

function GetExtFromFileDialogFilter(const AFilter: string; AIndex: integer): string;
var
  p, i: integer;
  inDesc:boolean;
begin
  { filter="Desc1|Ext1;Ext1b;Ext1c|Desc2|Ext2|..." }
  p := 1;
  i := 1;
  Result := '';
  inDesc := true;
  while p <= length(AFilter) do begin
    if AFilter[p] = '|' then begin
      if inDesc then begin
        if i = AIndex then begin
          inc(p);
          while (p <= length(AFilter)) and
            (not (AFilter[p] in [';','|'])) do
          begin
            if AFilter[p] <> '*' then
              Result := Result + AFilter[p];
            inc(p);
          end;
          break;
        end;
        inDesc := false;
      end else begin
        inc(i);
        inDesc := true;
      end;
    end;
    inc(p);
  end;
end;

{v0.16}
function GetDialogFilterIndexFromExt(const AFilter: string; const AExt: string; var AIndex: integer):boolean;
  { finds out what is the index of the extension AExt in the AFilter (property
    of Save/OpenDialog component) }
var
  p: integer;
  inDesc: boolean;
  ce, e: string;

begin
  { filter="Desc1|Ext1;Ext1b;Ext1c|Desc2|Ext2|..." }
  e := UpperCase(AExt);
  p := 1;
  Result := false;
  inDesc := true;
  ce := '';
  AIndex := 0;
  while p <= length(AFilter) do begin
    if AFilter[p] = '|' then begin
      if inDesc then begin
        ce := '';
        inDesc := false;
        inc(AIndex);
      end else begin
        if (UpperCase(ce) = e) then begin
          Result := true;
          exit;
        end;
        inDesc := true;
      end;
    end else begin
      if not inDesc then begin
        case AFilter[p] of
          '*':;
          ';': begin
            if (UpperCase(ce) = e) then begin
              Result := true;
              exit;
            end;
            ce := '';
          end;
        else
          ce := ce + AFilter[p];
        end;
      end;
    end;
    inc(p);
  end;
  if (not inDesc) and (UpperCase(ce) = e) then
    Result := true;
end;
{/v0.16}

procedure MemFree(var P{:pointer});
  { tries to free memory allocated to P, then sets it = nil }
var ptr: pointer absolute P;
begin
  if ptr <> nil then begin
    FreeMem(ptr);
    ptr := nil;
  end;
end;

procedure ClassFree(var P{:TObject});
  { tries to call P.Free, then assigns P = nil }
var o: TObject absolute P;
begin
  if o <> nil then begin
    o.Free;
    o := nil;
  end;
end;

function FixDecSep(const s: string): string;
  { replaces all decimal separator chars "," or "." with the one specified
    in SysUtils unit, so that the resulting number won't generate exception
    upon submiting it to SysUtils. StrToInt or StrToFloat functions }
var
  i: integer;
begin
  Result := '';
  for i := 1 to length(s) do begin
    if s[i] in [',','.'] then
      Result := Result +  DecimalSeparator {SysUtils, set in UlanGlob to '.'}
    else
      Result := Result + s[i];
  end;
end;

{v0.13}
function RelativeFileName(const ADir: string; const AFileName: TFileName): TFileName;

var
  d, fn: string;
  i: integer;
begin
  if ADir = '' then begin
    GetDir(0, d);
  end else begin
    d := ADir;
  end;
  fn := ExpandFileName(AFileName);
  i := pos(d, fn);
  if i > 0 then begin
    if d[length(d)] = '\' then
      i := 1
    else
      i := 2;
    Result := copy(fn, length(d) + i, length(fn) - length(d));
  end else begin
    Result := AFileName;
  end;
end;
{/v0.13}

end.
