{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit TslcUtil; //v0.7d

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1996-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self


interface

function TslcGetCheckStrRange(val: string; min, max: integer): integer;
function TslcStrToInt(val: string): integer;
function TslcStrTruth(val: string): boolean;
function TslcStrTruthDef(val: string; default: boolean): boolean;
procedure TslcLoadError(errCode: integer);
procedure TslcLoadErrorFmt(errCode: integer; const args: array of const);

implementation
uses Tslc, TslcPlat;
{$I TslcErr.inc}

procedure TslcLoadError(errCode: integer);
begin
	TclError( TslcLoadStr(errCode) );
end;

procedure TslcLoadErrorFmt(errCode: integer; const args: array of const);
begin
	TclErrorFmt( TslcLoadStr(errCode), args );
end;

function TslcGetCheckStrRange(val: string; min, max: integer): integer;
var
	E: integer;
begin
	System.Val(val, Result, E);
    if E <> 0 then
    	TclErrorFmt(TslcLoadStr(sTslcCannotConvertToInt_S), [val]);
    if result < min then
    	TclErrorFmt(TslcLoadStr(sTslcValueMinFail_SD),[val, min])
    else if result > max then
    	TclErrorFmt(TslcLoadStr(sTslcValueMaxFail_SD),[val, max]);
end;

function TslcStrToInt(val: string): integer;
var
	E: Integer;
begin
	System.Val(val, Result, E);
	if E <> 0 then
	   	TclErrorFmt(TslcLoadStr(sTslcCannotConvertToInt_S), [val]);
end;

function TslcStrTruth(val: string): boolean;
var
	E, i: integer;
begin
	System.Val(val, i, E);
    if E = 0 then
    	result := i <> 0
    else
	begin
    	result := True;
        if length(val) = 1 then
        begin
        	if pos(val, 'yYtT+') > 0 then
            	exit;
            result := pos(val, 'nNfF-') = 0;
            if not result then
            	exit;
        end else
        begin
        	if TslcTextEqual(val, 'YES') or TslcTextEqual(val, 'TRUE') then
            	exit;
            result := not (TslcTextEqual(val, 'NO') or TslcTextEqual(val, 'FALSE'));
            if not result then
            	exit;
		end;
        TclErrorFmt(TslcLoadStr(sTslcCannotConvertToBool_S), [val]);
    end;
end;

function TslcStrTruthDef(val: string; default: boolean): boolean;
begin
	try
    	result := TslcStrTruth(val);
    except
    	result := default;
    end;
end;

end.
