unit utslvclauxiliary;
{**
    @explan(说明) tslvcl 辅助库 %%
**}
//20221118 抽象计数锁定对象
//20220914 移入tire树
interface
function iffuncptr(fn);
function includestate(u,s);
function excludestate(u,s);
function makelong(low,high,ptrl);
function makeposition(x,y);
function getbitsfrominteger(n,b,e);
function unsignedtosigned(v,n);
function signedtounsigned(v,n);
function lowuperdword(value_,lvalue,uvalue,ptrl);
function FormatTslData(d,sj,tn);
function gettemppath();
function TSL_ReservedKeys2();              //保留关键字
function parsershortcutstr(s_); //快捷键解析
function lineintersect(xx1,xx2,xx);
function formatshortcut(d);
function getmonthdates(y,m);
function CallMessgeFunction(f,o,e);
////////////////////点区域操作//////////////////
function pointinrect(p,rec);
function intersectrect(rec1,rec2,irec);

function bitcombination(s,v,f);
function istextascii(s); //ansi编码
function isTextGBK(str);
function IsTextUTF8(str);
function exportjsonformat(d,tbw,ct);
function get_resource_by_name(n,full);
//****************************
///////////////////
function ParserCommandLine(s); //解析命令行参数
//function FormatTslData(d,sj,tn);
//function HexStrToTsl(hex);
//function TslToHexStr(d);
function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
function TS_GetUserProfileHome();
function TS_GetUserProfileHomeInstance(t:integer):string;
function TS_GetUserConfigHome(t:integer):string;
function TS_GetHomePath(t:integer):string;
function TS_ModulePath():string;
function TS_ExecPath():string;
function TS_GetAppPath():string;
function TS_GetIniPath(t:integer;iname:string):string;
function gettslexefullpath();
function int_to_binary(d,n); //整数转换成字符串
function rec_inc(rec,n); //挑战区域大小
//function tsl_str_head_at(s,n);
function get_tsl_mem_ptr(s,n);
function Encode_Password(s); //加密
function Decode_Password(s);//解密
function complementary_color(c);//补色计算
type tuiglobaldata=class() //全局对象存储
    static UIData;
    class Function uisetdata(n,d);
    begin
        InitUiData();
        UIData[n]:= d;
    end
    class function uigetdata(n);
    begin
        InitUiData();
        return UIData[n];
    end
    private
    class function InitUiData();
    begin
        if not ifarray(UIData)then UIData := array();
    end
end
type TCharDiscrimi=class() //字符判断
    private 
    static const CD_SMA = 97;
    static const CD_BGA = 65;
    static const CD_SMZ = 122;
    static const CD_BGZ = 90;
    static const CD_UDL =95;
    static const CD_NIN = 57;
    static const CD_ZER =48 ;
    public
    function IsLetter(cc);
    begin
        return IsUppercaseLetter(CC)OR IsLowercaseLetter(cc);
    end
    function IsLowercaseLetter(cc);
    begin
        return(cc >= CD_SMA)and(cc <= CD_SMZ);
    end
    function IsUppercaseLetter(cc);
    begin
        return(cc >= CD_BGA)and(cc <= CD_BGZ);
    end
    function IsNumber(cc);
    begin
        return(cc >= CD_ZER)and(cc <= CD_NIN);
    end
    function IsVariableName(s);
    begin
        if ifstring(s)and length(s)>= 1 then
        begin
            cc := ord(s[1]);
            if IsLetter(cc)or cc=CD_UDL then
            begin
                for i := 2 To length(s) do
                begin
                    cc := ord(s[i]);
                    if not(IsLetter(cc)or IsNumber(cc)or(cc=CD_UDL))then
                    begin
                        return false;
                    end
                end
                return true;
            end
        end
        return 0;
    end
    function IsLowercaseVariableName(s);
    begin
        if ifstring(s)and length(s)>= 1 then
        begin
            cc := ord(s[1]);
            if IsLowercaseLetter(cc)or cc=CD_UDL then
            begin
                for i := 2 To length(s) do
                begin
                    cc := ord(s[i]);
                    if not(IsLowercaseLetter(cc)or IsNumber(cc)or(cc=CD_UDL))then
                    begin
                        return false;
                    end
                end
                return true;
            end
        end
        return 0;
    end 
end
type tidcreater=class() //id生成
    {**
    		@ignore(忽略)
    	**}
    private
    __sid;
    cid;
    Reuseids;
    usedids;
    //protected
    {**
    		  @explan(说明) 不重复整数id 生成类  %%
    		  @param(cid)(integer) 当前id值 %%
    		  @param(Reuseids) (array) 已经回收的id %%
    		  
    		**}
    public
    function clean();
    begin
        Reuseids := array();
        cid := __sid;
    end
    function create(sid);
    begin
        {**
    		  @explan(说明) 构造函数 %%
    		  @param(sid)(integer) 初始化的id值
    		**}
        if ifnumber(sid)then cid := sid;
        else cid := 0;
        __sid := cid;
        usedids := Reuseids := array();
    end
    function createid();
    begin
        {**
    		  @explan(说明) 构造id  %%
    		  @return(integer) id值 %%
    
    		**}
        ret := nil;
        for i in Reuseids do
        begin
            if ifnumber(i)then
            begin
                ret := i;
                break;
            end
        end
        if ifnumber(ret)then
        begin
            reindex(Reuseids,array(ret:nil));
            usedids[ret]:= ret;
            return ret;
        end
        cid += 1;
        usedids[cid]:= cid;
        return cid;
    end
    function deleteid(id);
    begin
        {**
    		  @explan(说明) 不重复整数id 生成类  %%
    		  @param(id)(integer) 需要回收的id值 %%
    		  @return(bool) 是否成功
    		**}
        if ifnumber(id)then
        begin
            Reuseids[integer(id)]:= id;
            reindex(usedids,array(integer(id):nil));
            return 1;
        end
        return 0;
    end
    function addid(id);
    begin
        if ifnumber(id)and id>0 then
        begin
            cid := max(cid,id);
            usedids[id]:= id;
        end
    end
end
type TByteDataOP=class() //位操作类
    {**
    @explan(说明) 位操作封装
    **}
    {**
    @example(范例:byte数组转整数) 
    oa := new TByteDataOP();
    echo tostn(oa.bytesasint(array(1,1,1,1)));
			
    **}
    {**
    @example(范例:整数转byte数组) 
    oa := new TByteDataOP();
    echo tostn(oa.intasbytes(235);
			
    **}
    class function BytesAsInt(a);
    begin
        {**
        @explan(说明) 四个byte转换为integer %%
        @param(a)(array) 正式表示的四字节 %%
        @return(integer) 组装好的整数 %%
        **}
        uu := a[0];
        ul := a[1];
        lu := a[2];
        ll := a[3];
        l := makelong(ll,lu,8);
        u := makelong(ul,uu,8);
        return makelong(l,u);
    end
    class function IntAsBytes(v);
    begin
        {**
        @explan(说明) 整数转换为byte 数组(整数数组模拟) %%
        @param(v)(integer)  %%
        @return(array) 模拟的byte数组 %%
        **}
        lowuperdword(v,l,u);
        lowuperdword(l,ll,lu);
        lowuperdword(u,ul,uu);
        return array(uu,ul,lu,ll);
    end
    class function ShortsToInt(a);
    begin
        {**
        @explan(说明) 两个short转换为一个int  %%
        @param(a)(array)  两个元素的数组 %%
        @return(integer) 整数 %%
        **}
        l := a[1];
        u := a[0];
        return makelong(l,u);
    end
    class function IntToShorts(v);
    begin
        {**
        @explan(说明) 整数转换为两个short 数组(整数数组模拟) %%
        @param(v)(integer)  %%
        @return(array) 模拟的short数组 %%
        **}
        lowuperdword(v,l,u);
        return array(l,u);
    end
    class function StrAsBytes(s);
    begin
        {**
        @explan(说明) 字符串转换为byte数组 %%
        @param(s)(string)  字符串  %%
        @return(array) 模拟的byte数组 %%
        **}
        r := array();
        for i := 0 to length(s) do r[i]:= ord(s[i]);
        return r;
    end
    class function BytesAsStr(b);
    begin
        {**
        @explan(说明) byte数组转字符串 %%
        @param(b)(array)  byte数组  %%
        @return(string) 字符串 
        **}
        r := "";
        for i := 0 to length(b)-1 do r += chr(b[i]);
        return r;
    end
end

	//**************************数组链表类******************************************
type tarray1dlk=class //从0开始
    private
    _len;
    [weakref]FCompareValue;
    protected _data; //数据
    public
    {**
    @explan(说明) 一维链表类 %%
    @param(_len)(integer) 长度 %%
    @param(_data)(array) 数据 %%
    @param(CompareValue)(fpointer) 回调函数 function(v1,v2)begin return v1 = v2 ; end  %%
    **}
    function setdata(data);
    begin
        {**
        @explan(说明) 一次性设置数据 %%
        @param(data)(array) 数据 %%
        **}
        _data := data;
        _len := length(data);
    end
    function clean();
    begin
        {**
        @explan(说明) 清空 %%
        **}
        _data := array();
        _len := 0;
    end
    function create(); //构造
    begin
        {**
        @explan(说明) 构造 %%
        **}
        _data := array();
        _len := 0;
        onchangelock := true;
    end
    function CallCompare(v1,v2,f);
    begin
        if iffuncptr(f) then return call(f,v1,v2);
        if iffuncptr(FCompareValue)then return call(FCompareValue,v1,v2);
        return v1=v2;
    end
    function append(v) //追加
    begin
        {**
        @explan(说明) 追加 %%
        @param(v)() tsl数据 %%
        **}
        _data[_len++]:= v;
        dochanged("append");
    end;
    function geti(i); //获取
    begin
        {**
        @explan(说明) 获得 %%
        @param(i)(integer) id %%
        **}
        return _data[i];
    end
    function seti(i,v); //设置值
    begin
        {**
        @explan(说明) 设置值 %%
        @param(i)(integer) id %%
        @param(v)() tsl数据 %%
        **}
        if i >= 0 and i<_len then
        begin
            _data[i]:= v;
            dochanged("set");
        end
    end
    function deli(i); //删除
    begin
        {**
        @explan(说明) 删除 %%
        @param(i)(integer) id %%
        **}
        if i<0 or i >= _len then return 0;
        _len -= 1;
        r := deleteindex(_data,i,1);
        dochanged("del");
        return r;
    end
    function delis(i);
    begin
        {**
        @explan(说明) 批量删除 %%
        @param(i)(array) 删除的id %%
        **}
        dels := getdels(i);
        bkonchangelock := onchangelock;
        onchangelock := true;
        for ii,v in dels do deli(v);
        onchangelock := bkonchangelock;
        dochanged("dels");
    end
    function getdels(i); //删除多行
    begin
        {**
        @ignore (忽略) %%
        @explan(说明) 批量删除 %%
        @param(i)(array) 删除的id %%
        **}
        ii := sselect thisrow from(i union2 array())where(thisrow >= 0 and thisrow<_len)order by thisrow end;
        dels := array();
        ix := 0;
        for iv in ii do
        begin
            dels[iv]:= ii[iv]-ix;
            ix++;
        end
        return dels;
    end
    function insertbefor(v,i); //之前插入
    begin
        {**
        @explan(说明) 在i之前插入 %%
        @param(v)() 插入数据 %%
        @param(i)(integer) id %%
        **}
        if not ifnumber(i)then return;
        if i >= _len then return append(v);
        else if i <= 0 then
        begin
            _data := array(v)union _data;
        end else
        begin
            _data := _data[0:(i-1)]union array(v)union _data[i:];
        end
        _len++;
    end
    function insertafter(v,i); //之后插入
    begin
        {**
        @explan(说明) 在i之后插入 %%
        @param(v)() 插入数据 %%
        @param(i)(integer) id %%
        **}
        if not ifnumber(i)then return;
        if i >= _len then return append(v);
        else if i<0 then
        begin
            _data := array(v)union _data;
        end else
        begin
            _data := _data[0:i]union array(v)union _data[i+1:];
        end
        _len++;
        dochanged("insert");
    end
    function findvid(v1,func,lx); //查找序号,func通过送入的比较函数
    begin
        {**
        @explan(说明) 查找序号和v1 匹配的id %%
        @param(v1)(any) tsl数据 %%
        @param(lx)(bool) 逆序查找 %%
        @param(func)(fpointer) 比较函数 第一个参数为 数组中对象,第二个参数为输入判断条件 %%
        **}
        ret :=-1;
        if lx then
        begin
            for i := length(_data) downto 0 do
            begin
                if CallCompare(_data[i],v1,func)then return i;
            end
            return ret;
        end
        for i,v in _data do
        begin
            if CallCompare(v,v1,func)then
            begin
                return i;
            end
        end
        return ret;
    end
    function getprev(v1); //获得上一个
    begin
        {**
        @explan(说明) 获得上一个 匹配的id %%
        @param(v1)() tsl数据 %%
        **}
        if _len<2 then return nil;
        id :=-1;
        for i,v in _data do
        begin
            if CallCompare(v,v1)then
            begin
                id := i;
                break;
            end
        end
        return _data[id-1];
    end
    function getnext(v1); //获得下一个
    begin
        {**
        @explan(说明) 获得下一个 匹配的id %%
        @param(v1)() tsl数据 %%
        **}
        if _len<2 then return nil;
        id := _len;
        for i,v in _data do
        begin
            if CallCompare(v,v1)then
            begin
                id := i;
                break;
            end
        end
        return _data[id+1];
    end
    function ergodic(f); //循环处理
    begin
        {**
        @explan(说明) 循环所有数据 %%
        @param(f)(fpointer) 处理函数 function(id,v) begin end  %%
        **}
        if not iffuncptr(f)then return nil;
        for i,v in _data do
        begin
            ret := call(f,i,v); //## f(i,v);
            if ret=-1 then break;
        end
        return 1;
    end
    function data(); //数组数据
    begin
        {**
        @explan(说明) 返回所有数据 %%
        **}
        return _data;
    end
    function replace(i,v) //替换
    begin
        {**
        @explan(说明) 替换 %%
        @param(i)(integer) 序号  %%
        @param(v)() tsl数据  %%
        **}
        if i >= 0 and i<_len then
        begin
            ret := _data[i];
            _data[i]:= v;
            dochanged("replace");
            return ret;
        end else
        return nil;
    end
    function len(); //大小
    begin
        {**
        @explan(说明) 长度 %%
        **}
        //return length(_data);
        return _len;
    end
    function setorder(i,j);
    begin
        {**
        @explan(说明) 设置元素位置 %%
        @param(i)(integer)原始位置 %%
        @param(j)(integer) 移动后的位置
        **}
        if j>_len-1 then j := _len-1;
        if j<0 then j := 0;
        if i=j or(i<0 or i>_len)then exit; //修改
        sl := createserial(i,j);
        for ii := 0 to length(sl)-2 do
        begin
            SwapNoCheck(sl[ii],sl[ii+1]);
        end
        dochanged("order");
    end
    function swap(i,j); //交换
    begin
        {**
        @explan(说明) 交换 %%
        @param(i)(integer) 序号  %%
        @param(j)(integer) 序号  %%
        **}
        if ifnumber(i)and ifnumber(j)and i <> j and i >= 0 and j >= 0 and i<_len and j<_len then
        begin
            SwapNoCheck(i,j);
            //vi := _data[i];
            //_data[i]:=_data[j];
            //_data[j] := vi;
        end
        dochanged("order");
    end
    property CompareValue read FCompareValue write FCompareValue;
    property onchanged read fonchanged write fonchanged;
    onchangelock;
    private
    function dochanged(info);
    begin
        if onchangelock then return ;
        if fonchanged then         CallMessgeFunction(fonchanged,self(true),info);    
    end 
    function SwapNoCheck(i,j);
    begin
        vi := _data[i];
        _data[i]:= _data[j];
        _data[j]:= vi;
    end
    function createserial(i,j);
    begin
        if j>i then return i -> j;
        r := array();
        kk := 0;
        for ii := i downto j do r[kk++]:= ii;
        return r;
    end
    function moveto(i,j); //将i移动到j前面
    begin
        {**
        @ignore 忽略%%
        @explan(说明) 将i移动到j前面 %%
        @param(i)(integer) 序号  %%
        @param(j)(integer) 序号  %%
        **}
        if not(ifnumber(i)and i >= 0 and i<_len)then return-1;
        if ifnil(j)then j := 0;
        if i=j then return-1;
        vi := geti(i);
        insertbefor(vi,j);
        if i>j then
        begin
            deli(i+1);
        end else
        begin
            deli(i);
        end
    end
    fonchanged;
end
type TFpList=class(tarray1dlk)
    {**
    @explan(说明) list类 %%
    **}
    function create();
    begin
        inherited;
    end
    function indexof(v,f,lx);
    begin
        {**
        @explan(说明) 查找值v在序列中的位置 %%
        @param(v)(any) 任何类型 %%
        @return(integer) 位置 ,等于-1 表示没查找到 %%
        **}
        return findvid(v,f,lx);
    end
    function operator[](index);
    begin
        {**
        @explan(说明)获取序号为index的值 %%
        @return(any) 数据 %%
        **}
        return geti(index);
    end
    function add(v);
    begin
        {**
        @explan(说明)追加数据到链表 %%
        @param(v)(any) 数据 %%
        **}
        return append(v);
    end
    function Remove(v);
    begin
        {**
        @explan(说明)删除数据V %%
        @param(v)(any) 数据 %%
        **}
        return deli(indexof(v));
    end
    function last();
    begin
        {**
        @explan(说明)获取最后一个数据 %%
        @return(any) 数据 %%
        **}
        return geti(self.Count()-1);
    end
    function Count();
    begin
        {**
        @explan(说明)获取数据个数 %%
        @return(integer) %%
        **}
        return len();
    end
end
type tmy_map = class() //map对象
    function create();
    begin
        clear();
        fignorecase := true;
    end 
    function operator[](idx);//get data
    begin
        k := get_true_key(idx);
        return fkvs[k,1];    
    end 
    function operator[1](idx,v);//设置数据
    begin
        set_key_val(idx,v);      
    end
    function operator length();
    begin
        return ::length(fkvs);
    end 
    function operator for(idx); //for循环
    begin
        init :=  (idx .& 1)=0;
        if init then 
        begin
            formatkvs2();             
            fforpos := -1;
            fforcount := ::length(fkvs2);
        end 
        iv := (idx .& 2)=2;
        if iv then //
        begin
            if fforpos<fforcount then 
            begin
                fforpos++;
                return array(fkvs2[fforpos,0],fkvs2[fforpos,1]);                
            end
        end else 
        begin 
            if fforpos<fforcount then 
            begin
                fforpos++;
                return fkvs2[fforpos,0];
            end 
        end 
        return nil;
    end
    function operator deleteindex(idx,flg);
    begin
        k := get_true_key(idx);
        if ::deleteindex(fkvs,k,false) then 
        begin
            fchanged := true;
        end 
    end 
    function operator mrows(flg)
    begin
        if flg then 
        begin 
            formatkvs2();
            return fkvs2[:,0];
        end 
        return length(fkvs);
    end 
    function clear(); //清理
    begin
        fkvs := array();
        fkvs2 := array();
        fchanged := false;
    end 
    property ignorecase read fignorecase write setignorecase; //忽略大小写
    private
    function get_true_key(k);
    begin
        if fignorecase and ifstring(k) then return lowercase(k);
        return k;
    end 
    function setignorecase(flg);
    begin
        nv := flg?true:false;
        if nv<>fignorecase then 
        begin             
            reset := not fignorecase ;
            fignorecase := nv;
            if reset then 
            begin 
                fchanged := true;
                tp := fkvs;
                fkvs := array();
                for i,v in tp do 
                begin 
                    set_key_val(v[0],v[1]);    
                end 
            end     
        end 
    end 
    function set_key_val(idx,v);
    begin
        k := get_true_key(idx);
        fchanged := true;
        if ifnil(v) then 
        begin 
            reindex(fkvs,array(k:v));
        end else 
        begin 
            fkvs[k] := array(idx,v);        
        end   
    end 
    function formatkvs2(); //格式化
    begin
        if fchanged then 
        begin 
            fchanged := false;
            fkvs2 := array();
            ct := 0;
            for i,v in fkvs do 
            begin 
                fkvs2[ct++] := v;    
            end 
        end 
    end 
    fignorecase;
    fforcount;
    fforpos;
    fchanged;
    fkvs2; //for 处理
    fkvs;
end 
type tstrindexarray = class() //字符串大小写无关下标数组
    {**
    @explan(数组类型) 忽略字符串下标的大小写%%
    **}
    function create();
    begin
        FData := array();
        FRows := array();
    end
    function DeleteIndex(idx);
    begin
        {**
        @explan(说明) 删除指定下标 %%
        **}
        if ifnil(idx) or ifobj(idx)then return 0;
        if ifstring(idx)then
        begin
            lidx := lowercase(idx);
            ::deleteindex(FData,lidx,0);
            return ::deleteindex(FRows,lidx,0);
        end
        ::deleteindex(FData,idx,0);
        return ::deleteindex(FRows,idx,0);
    end
    function Operator[1](index,value);
    begin
        if ifstring(index)then
        begin
            li := lowercase(index);
        end else
        li := index;
        if ifnone(value)then
        begin
            r := FData[li];
            if r then return r;
            r := new tstrindexarray();
            FData[li]:= r;
            FRows[li]:= index;
            return r;
        end
        FRows[li]:= index;
        if ifarray(value)and value then
        begin
            r := new tstrindexarray();
            FData[li]:= r;
            for i,v in value do
            begin
                r[i]:= v;
            end
            return;
        end
        FData[li]:= value;
    end
    function Operator[](index);
    begin
        if ifstring(index)then r := FData[lowercase(index)];
        else r := FData[index];
        //if ifnil(r) then return NeW tstrindexarray();
        return r;
    end
    function Size();
    begin
        {**
        @explan(说明) 获得长度 %%
        **}
        return Length(FData);
    end
    function toarray(n);
    begin
        {**
        @explan(说明) 获得tsl array %%
        @param(n)(bool) false 返回小写下标，true 返回原始下标 %%
        **}
        r := array();
        for i,v in FData do
        begin
            if v is class(tstrindexarray)then
            begin
                r[n?i:FRows[i]]:= v.toarray(n);
            end else
            r[n?i:FRows[i]]:= v;
        end
        return r;
    end
    function IndexNames();
    begin
        {**
        @explan(说明) 获得 所有下标 %%
        **}
        return FRows;
    end
    function HaveIndex();
    begin
        {**
        @explan(说明) 判断是否有某个下标 %%
        **}
        o := self(true);
        for i := 1 to Paramcount do
        begin
            if not(o is class(tstrindexarray))then return false;
            id := params[i];
            if ifnil(o.TrueIndex(id))then return false;
            o := o[id];
        end
        return true;
    end
    function TrueIndex(n);
    begin
        {**
        @explan(说明) 获得对应下标 %%
        **}
        if ifstring(n)then idx := lowercase(n);
        else idx := n;
        return FRows[idx];
    end
    property Data write SetData;
    function destroy();
    begin
        FData := nil;
        FRows := nil;
    end
    private
    function SetData(d);
    begin
        if not ifarray(d)then return false;
        FRows := array();
        FData := array();
        si := self(true);
        for i,v in d do
        begin
            si[i]:= v;
        end
        return true;
    end
    FData;
    FRows;
end
type tnumindexarray = Class() //栈模拟
    {**
    @explan(说明) 数字下标数组对象 %%
    **}
    private
    FData;
    fdlength;
    public
    function Create();virtual;
    begin
        {**
        @explan(说明) 构造函数 %%
        **}
        FData := array();
        fdlength := 0;
    end
    function Operator[1](idx,v);
    begin
        {**
        @explan(说明)通过下标设置元素 %%
        **}
        return SetValueByIndex(idx,v);
    end
    function Operator[](idx);
    begin
        {**
        @explan(说明) 通过下标获取元素 %%
        **}
        return GetValueByIndex(idx);
    end
    function operator length();
    begin
        {**
        @explan(说明) 获得数据长度 %%
        @return(integer) 长度 %%
        **}
        return fdlength;
    end
    function Push({value1,value2,....});
    begin
        {**
        @explan(说明) 在末尾追加元素,参数个数不定 %%
        **}
        return pushs(params);
    end
    function Pop();
    begin
        {**
        @explan(说明) 弹出末尾的元素 %%
        **}
        if FData then
        begin
            id := fdlength-1;
            r := FData[id];
            deleteindex(FData,id);
            fdlength--;
            LengthChanged(-1);            
            return r;
        end
        return nil;
    end
    function IndexOf(v);
    begin
        for i,vi in FData do
        begin
            if vi=v then return i;
        end
        return -1;
    end
    function LastIndexOf(v);
    begin
        len := fdlength;
        for i := len-1 downto 0 do
        begin
            if v=FData[i] then return i;
        end
        return -1;
    end
    function GetValueByIndex(idx);virtual;
    begin
        return FData[idx];
    end
    function SetValueByIndex(idx,v);virtual;
    begin
        len := fdlength;
        if not(idx>=0) then return nil;
        if idx <= len then
        begin
            FData[idx]:= v;
        end else
        begin
            for i := len to idx do FData[i]:= nil;
            FData[idx]:= v;                      
        end
        fdlength := ::length(FData);  
        return v;
    end
    function splice({startid,sellength,value1,valfue2,....});
    begin
        p := params;
        return splices(p[0],p[1],p[2:]);
    end
    function shift();
    begin
        {**
        @explan(说明) 弹出头部元素 %%
        **}
        r := nil;
        len := fdlength;
        if len>0 then
        begin
            deleteindex(FData,0);
            fdlength--;
            LengthChanged(-1);            
        end
        return len<1?(len):(len-1);
    end
    function unshift({value1,value2,....});
    begin
        {**
        @explan(说明) 在数据头部加入元素,个数待定 %%
        **}
        return unshifts(params);
    end
    function swap(i,j);
    begin
        {**
        @explan(说明) 交换下标中的值 %%
        **}
        if i=j then return false;
        len := fdlength;
        if i >= 0 and i<len and j >= 0 and j<len then
        begin
            t := FData[i];
            FData[i]:= FData[j];
            FData[j]:= t;
            return true;
        end
        return false;
    end
    function pushs(vs);
    begin
        if not(vs) and length(vs) then return r;
        r := fdlength;
        r1 := r;
        FData union=vs;
        r := length(FData);
        //for i,v in vs do //20230724 修改 减少循环
        //begin
        //    FData[r]:= v; 
        //    r++;   
        //end 
        fdlength := r;
        if r1 <> r then LengthChanged(r1-r);        
        return r;
    end
    function unshifts(vs);
    begin    
        if ifarray(vs) and vs then
        begin
            FData := vs union FData;
            fdlength := ::length(FData);
            LengthChanged(1);            
        end
        return fdlength;
    end
    function splices(startid,sellength,vs);
    begin
        {**
        @explan(说明) 替换元素,第一个参数为开始位置,第二个为替换的个数,以后的参数为用来替换的值,返回被替换的值%%
        **}
        st := startid;
        if not(st>=0) then st := 0;
        sl := sellength;
        sl := ifnil(sl)?inf:sl;
        sl := (sl>=0)?sl:0;
        len := fdlength;
        st := st<0?0:st;
        st := st >= len?(len):st;
        et := st+sl;
        et := et >= len?(len):et;
        r := array();
        r := FData[st:(et-1)];
        r1 := FData[0:st-1];
        r2 := FData[et:len-1];
        if ifarray(vs) and vs then 
        begin 
            FData := r1 union vs union r2;
            
        end else 
        begin 
            FData := r1  union r2;    
        end         
        fdlength := ::length(FData);
        if len <>  fdlength then LengthChanged(fdlength-len);
        return r;
    end
    function set_len(n); //设置长度
    begin
        if fdlength<>n and n>=0 then 
        begin
            ol := fdlength;
            fdlength := n;
            FData := nils(n);  
            LengthChanged(n-ol);  
        end          
    end
    function LengthChanged(n);virtual;
    begin
    end
    property Data read FData;
    {**
    @param(Data)(array) 数据 %%
    **}
end
type tnumindexarrayex = class(tnumindexarray)
    {**
        @explan(说明) 扩展模拟数组 %%
    **}
    function create();
    begin
        inherited;
    end 
    function Deli(idx);
    begin
        r := splice(idx,1);
        return r?true:false;
    end 
    function geti(i);
    begin
        return GetValueByIndex(i);
    end 
    function InsertBefor(it,idx);
    begin
        splice(idx,0,it);
    end 
    function clean();
    begin
        splice(nil,nil);
    end 
    function setorder(i,j);
    begin
        {**
        @explan(说明) 设置元素位置 %%
        @param(i)(integer)原始位置 %%
        @param(j)(integer) 移动后的位置
        **}
        len := count-1;
        if j>len then j := len;
        if j<0 then j := 0;
        if i=j or(i<0 or i>len)then exit;       
        d := splice(i,1);
        splice(j,0,d[0]);    
    end
    function append(v);
    begin
        Push(v);
    end
    function add(v) ;
    begin
        Push(v);
    end 
    function Remove(v);
    begin
        return deli(indexof(v));
    end 
    property count read length;
end 
//ifdef newgetop
type trefarray = class() //数组成员引用模拟
    function create(d); //构造函数
    begin
        FData := d; 
    end 
    function mgset(idxs,v); //根据下标设置值
    begin
        return domgset(FData,idxs,v);
    end 
    function mgget(idxs); //根据获得值
    begin
        return domgget(fdata,idxs);          
    end 
    function operator[0](idx,v); //获取值
    begin        
        if v<0 then  //一级直接返回
        begin            
            return mgget(array(idx));   
        end 
        return new trefgetter(self,idx);//多级的时候构建一个中间对象
    end 
    function operator[1](idx,v); //设置值
    begin
        if ifnone(v) then  //多级构建一个中间对象
        begin
            return new trefsetter(self,idx);
        end 
        return mgset(array(idx),v); //一级直接返回
    end
    published
    property data read FData write setdata;
    protected
    function setdata(d);virtual;
    begin
        if FData<>d  then 
        begin 
            FData := d;
            return true;
        end         
    end 
    function domgget(d,idxs);virtual; //根据获得值
    begin
        if not ifarray(idxs) then return nil;
        if ifarray(d) then 
        begin
            if ifarrayidx(idxs) then 
            begin 
                return eval(&("d"+formatarrayidx(idxs)));
            end         
            return magicgetarray(d,idxs);  
        end 
        if d is class(trefarray) then return d.mgget(idxs,v);              
    end 
    function domgset(d,idxs,v);virtual; //根据下标设置值
    begin
        if not ifarray(idxs) then return nil;
        if ifarray(d) then 
        begin
            if ifarrayidx(idxs) then 
            begin 
                fsettemp := v;
                s := "d"+formatarrayidx(idxs)+":=fsettemp;";
                r :=  eval(&(s)); 
                fsettemp := nil;
                return r;               
            end 
            return magicsetarray(d, idxs,v); 
        end 
        if d is class(trefarray) then return d.mgset(idxs,v); 
        return nil;   
    end 
    function ifarrayidx(idx);
    begin
        for i,v in idx do 
        begin
            if ifarray(v) then return true;
        end 
    end 
    function formatarrayidx(idx);
    begin
        r := "[";
        len := length(idx)-1;
        for i ,v in idx do 
        begin
            if ifarray(v) then r+=tostn(v);
            else r+=tostn(v);
            if i<len then 
            begin
                r+=",";
            end    
        end 
        r+="]";
        return r;
    end 
    FData; //原始数据
    private  //成员变量
    fsettemp;
    private 
    
    private //中间对象
    type trefsgter = class() 
        function create(a,idx);
        begin
            FA := a; 
            FIndexs := array(idx); 
            FIndexsidx := 1;  
        end 
        protected
        FA;
        FIndexs;
        FIndexsidx;
    end 
    type trefgetter = class(trefsgter) //getter 对象
        function operator[0](idx,v);
        begin
            FIndexs[FIndexsidx++] := idx;
            if v<0 then 
            begin            
                return fa.mgget(FIndexs);    
            end 
            return self;    
        end 
        function create(a,idx);
        begin
            inherited;   
        end 
    end 
    type trefsetter = class(trefsgter) //setter 对象
        function operator[1](idx,v);
        begin
            FIndexs[FIndexsidx++] := idx;
            if ifnone(v) then return self;
            return fa.mgset(FIndexs,v);
        end 
        function create(a,idx);
        begin
            inherited;
        end 
    end
end;
type TGlobalValues=class() //全局对象,窗口构造中使用
    private
    static FValues;
    FId;
    class function sinit();
    begin
        if not ifarray(FValues)then FValues := array();
    end
    public
    class function getvalue(id);
    begin
        sinit();
        r := FValues[inttostr(id)];
        //if r then reindex(FValues,id);
        return r;
    end
    function Create(id,value);
    begin
        sinit();
        tid := inttostr(id);
        FOld := FValues[tid];
        if not ifnil(FOld)then raise "全局变量冲突!";
        FId := tid;
        FValues[tid]:= value;
    end
    function destroy();
    begin
        reindex(FValues,array(FId:nil));
    end
end
type TArrayTreeClass = class() //数组到树的转换
    {**
    	@explan(说明) 树形类 %%
    	@param(FIdName)(integer | string) id名称 %%
    	@param(FPIdName)(integer | string) 父节点名称 %%
    **}
    {**
    	@example(转换范例) %%
    		d := array(("id":1,"pid":5,"caption":"jd1"),
    			("id":4,"pid":2,"caption":"jd2"),
    			("id":2,"pid":1,"caption":"jd3"),
    			("id":3,"pid":2,"caption":"jd4"),
    			("id":5,"pid":7,"caption":"jd5"),
    			);
    		dt := class(TArrayTreeClass).ToTreeArray(d,array("id":"id","pid":"pid","sub":"sub"));
    		return dt;
    **}
    private
    class function ClumnNameOk(id);
    begin
        return ifnumber(id) or ifstring(id) ;
    end 
    static FCounter;
    static FIdName;
    Static FPIdName; 
    static FSubName;
    static FSInToArray;
    FRecyce;
    FInToArray;
    FComponents; //节点
    FId; //id
    FValue; //数据
    class function initconter();
    begin
        FCounter := 1;
    end
    class function GetCounter();
    begin
        return FCounter++;
    end
    public
    class function SetIdName(id,pid,sub);
    begin
        if(id <> pid)and(ifstring(id)or ifnumber(id))and(ifstring(pid)or ifnumber(pid))and(ifstring(sub)or ifnumber(sub))then
        begin
            FIdName := id;
            FPIdName := pid;
            FSubName := sub;
        end
    end
    function create(v);
    begin
        {**
        @explan(说明) 构造节点 %%
        **}
        FId := v[FIdName];
        FValue := v;
        FComponents := array();
    end
    function addcomponent(o);
    begin
        {**
        @explan(说明) 添加节点 %%
        **}
        len := length(FComponents);
        for i := 0 to len-1 do if o=FComponents[i]then exit;
        FComponents[len]:= o;
    end
    function Recycle();
    begin
        {**
        @explan(说明) 出现死循环的时候的处理 %%
        **}
        if FRecyce then return;
        FRecyce := true;
        for i,v in FComponents do
        begin
            v.Recycle();
        end
        FComponents := array();
    end
    function toarray();
    begin
        {**
        @explan(说明) 转换为array %%
        **}
        if FInToArray=FSInToArray then
        begin
            Recycle();
            raise "节点关系出现循环";
        end
        FInToArray := FSInToArray;
        ret := array();
        sub := array();
        for i := 0 to length(FComponents)-1 do
        begin
            ret[FSubName,i]:= FComponents[i].toarray();
        end
        for i,v in FValue do
        begin
            if i=FSubName then continue;
            ret[i]:= v;
        end
        return ret;
    end
    class function SetColumnName(info);
    begin
        if not ifarray(info)then info := array("id":"id","pid":"pid","sub":"sub");
        if not ClumnNameOk(info["id"])then info["id"]:= "id";
        if not ClumnNameOk(info["pid"])then info["pid"]:= "pid";
        if not ClumnNameOk(info["sub"])then info["sub"]:= "sub";
        SetIdName(info["id"],info["pid"],info["sub"]);
    end
    class function ToTree(d,info);
    begin
        {**
        @explan(说明) 二维表转换为树结构 %%
        @param(d)(array) 数据包含 信息 %%
        @param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
        默认值 array("id":"id","pid":"pid","sub":"sub"); %%
        @return(TArrayTreeClass) 
        **}
        SetColumnName(info);
        root := new TArrayTreeClass(array(FIdName:nil,FPIdName:nil));
        oarray := array();
        oarray[-inf]:= root;
        for i,v in d do //构建id
        begin
            id := v[FIdName];
            ido := oarray[id];
            if ifnil(ido)then
            begin
                ido := new TArrayTreeClass(v);
                oarray[id]:= ido;
            end
        end
        ifcycle := true;
        for i,v in d do
        begin
            id := v[FIdName];
            ido := oarray[id];
            pid := v[FPIdName];
            pdo := oarray[pid];
            if not pdo then
            begin
                pdo := oarray[-inf];
                ifcycle := false;
            end
            pdo.addcomponent(ido);
        end
        if ifcycle and oarray then
        begin
            for i,v in oarray do
            begin
                v.Recycle();
                raise "节点关系出现循环";
                break;
            end
        end
        return root;
    end
    class function CreateRow(d,id,r);
    begin
        for i,v in d do
        begin
            ri := array();
            if not v then continue;
            ri[FIdName]:= GetCounter();
            ri[FPIdName]:= id;
            for j,vi in v do
            begin
                if j=FSubName then
                begin
                    call(thisfunction,vi,ri[FIdName],r);
                end
                {else if j=FIdName or j = FPIdName then 
                begin
    					
                end}else
                begin
                    ri[j]:= vi;
                end
            end
            if ri then
            begin
                r[length(r)]:= ri;
            end
        end
    end
    class function TreeArrayToArray(d,info);
    begin
        {**
        @explan(说明) 树结构转换为二维表 %%
        @param(d)(array) 数据包含 信息 %%
        @param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
        默认值 array("id":"id","pid":"pid","sub":"sub"); %%
        @return(array) 
        **}
        if not ifarray(d)then exit;
        SetColumnName(info);
        r := array();
        initconter();
        CreateRow(d,GetCounter(),r);
        return r;
    end
    class function ToTreeArray(d,info);
    begin
        {**
        @explan(说明) 二维表转换为树结构 %%
        @param(d)(array) 数据包含 信息 %%
        @param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
        默认值 array("id":"id","pid":"pid","sub":"sub"); %%
        @return(array) 树形结构的array
        **}
        root := ToTree(d,info);
        if not root then return;
        FSInToArray := tostn(now());
        r :=(root.toarray());
        return r;
    end
end 

type TNode = class() //树节点
    {**
    @explan(说明) 树结点 %%
    **}
    private
    FItems; //子项
    [weakref]FParent; //父节点
    public
    function Create();virtual;
    begin
        inherited;
        FExpanded := true;
        FItems := new TFpList(); //子项
    end
    function CreateNode();virtual;
    begin
        return CreateObject(self(true).Classinfo(1));
    end
    function CreateNodeAndAppend();virtual; //构造并追加
    begin
        nd := CreateNode();
        AppendNode(nd);
        return nd;
    end
    function GetNodeByIndex(idx);
    begin
        {**
        @explan(说明) 通过序号获得子节点%%
        @param(idx)(TNode) %%
        **}
        if idx >= 0 then return FItems[idx];
        return nil;
    end
    function set_node_index(nd,idx); //设置子项次序
    begin
        if not(idx>=0) then return -1;
        oidx := FItems.indexof(v); 
        if oidx>=0 and idx<>oidx then 
        begin
            setorder(oidx,idx);    
        end else return 0;
        return 1;   
    end 
    function indexof(v); //获得序号
    begin
        return FItems.indexof(v);
    end
    function GetIndex();virtual;
    begin
        {**
        @explan(说明) 获得在父节点中的序号 %%
        @return(integer) 序号 %%
        **}
        if Parent then return Parent.indexof(self);
        return -1;
    end
    function AppendNode(it);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)(TNode) 节点 %%
        @return(bool) 是否成功 %%
        **}
        return InsertNode(it,FItems.Count);
    end
    function HasNode(nd);virtual;
    begin
        {**
        @explan(说明) 是否为某个节点的祖先节点 %%
        @param(nd)(TNode) 子节点 %%
        @return(TNode|0) 如果为祖先节点,就返回查询节点的父节点 %%
        **}
        if not(nd is class(TNode))then return 0;
        p1 := nd.Parent;
        p := p1;
        while p do
        begin
            if p=self then return p1;
            if p is class(TNode)then p := p.Parent;
        end
        return 0;
    end
    function DeleteNode(nd);virtual;
    begin
        {**
        @explan(说明) 删除节点 %%
        @param(nd)(TNode) 待删除节点 %%
        **}
        if nd=self then return 0;
        pn := HasNode(nd);
        if not pn then return;
        return pn.DeleteChildNode(nd);
    end
    function DeleteChildNode(nd);
    begin
        {**
        @explan(说明) 删除子节点%%
        @param(nd)(TNode) 节点 %%
        **}
        idx :=-1;
        idx := indexof(nd);
        if idx=-1 then return 0;
        return DeleteNodeByIndex(idx);
    end
    function DeleteNodeByIndex(idx);
    begin
        {**
        @explan(说明) 根据位置删除节点%%
        @param(idx)(integer) 序号 %%
        **}
        nd := FItems[idx];
        if not nd then return;
        //是否显示处理
        FItems.Deli(idx);
        FCurrentDeleteNode := nd;
        nd.parent := self(true);
        FCurrentDeleteNode := nil;
        return true;
    end
    function DeleteChildren();virtual; //
    begin
        {**
        @explan(说明) 删除所有的子节点%%
        **}
        while NodeCount>0 do
        begin
            idx := 0;
            it := FItems[idx];
            FCurrentDeleteNode := it;
            it.parent := self(true);
            FCurrentDeleteNode := nil;
            FItems.Deli(idx);
        end
    end
    function InsertNodes(its,idx);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)( array of TNode) 字符串 %%
        @param(idx)(integer) 序号 默认为0 %%
        **}
        idx0 := idx;
        if idx<0 then idx0 := 0;
        if idx>FItems.Count then idx0 := FItems.Count;
        bidx := idx0;
        for i,it in its do
        begin
            if node_insert_check(it) then
            begin
                FItems.InsertBefor(it,idx0);
                FCurrentAddNode := it;
                it.Parent := self(true);
                FCurrentAddNode := nil;
                idx0++;
            end
        end
    end
    function InsertNode(it,idx);virtual;
    begin
        {**
        @explan(说明) 插入一个节点 %%
        @param(it)(TNode) 字符串 %%
        @param(idx)(integer) 序号 默认为0 %%
        **}
        if node_insert_check(it) then
        begin
            if idx<0 then idx := 0;
            if idx>FItems.Count then idx := FItems.Count;
            if not(idx >= 0)then idx := 0;
            FItems.InsertBefor(it,idx);
            FCurrentAddNode := it;
            it.Parent := self(true);
            FCurrentAddNode := nil;
            return true;
        end
    end
    function node_insert_check(it);virtual;
    begin
        return (it is class(TNode))and(not it.Parent);
    end 
    function Expand();virtual; //展开
    begin
        FExpanded := true;
    end
    function UnExpand();virtual; //折叠
    begin
        FExpanded := false;
    end
    function RecyclingChildren();virtual;
    begin
        while NodeCount>0 do
        begin
            it := FItems[0];
            it.Recycling();
        end
    end
    function Recycling();virtual;
    begin
        p := FParent;
        if p then
        begin
            p.DeleteNode(self);
        end
        while NodeCount>0 do
        begin
            it := FItems[0];
            it.Recycling();
        end
        //inherited;
    end
    property NodeCount read GetNodeCount; //节点数
    property Expanded read FExpanded write SetExpand; //展开 
    property Parent read FParent write SetParent; //父节点
    property LastChild read GetLstChild;
    {**
    @param(NodeCount)(integer) 子节点数量 %%
    @param(Expanded)(bool) 是否展开 %%
    @param(Parent)(TNode) 父节点 %%
    **}
    protected 
    property CurrentDeleteNode read FCurrentDeleteNode;
    property CurrentAddNode read FCurrentAddNode;
    {**
    @ignoremembers(CurrentDeleteNode,CurrentAddNode)
    **}
    function SetParent(V);virtual;
    begin
        tp := Parent;
        if tp and (v=tp) and( v.CurrentDeleteNode=self ) then 
        begin
            FParent := nil;
            return;
        end 
        if (v=tp) then return;
        if(v is class(TNode))then
        begin
            if v.CurrentAddNode=self then
            begin
                FParent := v; //新节点 
            end else
            if v.CurrentDeleteNode=self then //从节点移除
            begin
                FParent := nil;
            end else
            begin
                if tp=v then return;
                if tp then
                begin
                    tp.DeleteNode(self(true));
                end
                v.InsertNode(self(true),v.NodeCount);
            end
        end else
        begin
            if tp then tp.DeleteNode(self(true));
        end
    end
    private
    fwilldelete;
    fwilladd;
    function GetLstChild();
    begin
        return FItems[FItems.Count-1];
    end
    FCurrentDeleteNode;
    FCurrentAddNode;
    FExpanded;
    function SetExpand(v);virtual; //已经展开
    begin
        if v then Expanded();
        else UnExpand();
    end
    function GetNodeCount(); //子节点数
    begin
        return FItems.Count;
    end
end
type TTire = class()
{**
    @explan(说明) tire树
**}
    type TTireNode = class()
        FChar;
        FSub;
        FEnd;
        Ficase;
        _tag;
        function Create(v);
        begin
            FChar := v;  
            FSub := array();  
            FEnd := false;
            Ficase := false;
        end 
        function Add(s);
        begin
            v0 := s[1];
            if Ficase then v0 := lowercase(v0);
            vsub := FSub[v0]; 
            if not vsub then 
            begin
                vsub := new  TTireNode(v0);
                vsub.Ficase := Ficase;
                FSub[v0] := vsub;  
            end 
            ls := length(s);
            if ls>1 then 
                return vsub.Add(s[2:]);
            else 
            begin
                vsub.FEnd := true;
                return vsub;
            end 
        end 
        function Find(s,slen,idx);
        begin
            if idx>slen then return FEnd;
            v0 := s[idx];
            if Ficase then v0 := lowercase(v0);
            vsub := FSub[v0]; 
            if vsub then 
            begin
                idx++;
                return vsub.Find(s,slen,idx);
            end 
            return FEnd ;
        end  
        function find_node(s,slen,idx);
        begin
            if idx>slen then return (FEnd?self:0);
            v0 := s[idx];
            if Ficase then v0 := lowercase(v0);
            vsub := FSub[v0]; 
            if vsub then 
            begin
                idx++;
                return vsub.find_node(s,slen,idx);
            end 
            return (FEnd?self:0);    
        end 
        function seticase(i);
        begin
            ni := i?true:false;
            if ni<>Ficase then 
            begin
                Ficase := ni;
                for i,v in mrows(FSub,1) do 
                begin
                    vi := FSub[v];
                    if ni then //忽略大小写
                    begin
                        reindex(FSub,array(v:nil));
                        FSub[lowercase(vi.FChar)] := vi;    
                    end else //区分大小写
                    begin
                        reindex(FSub,array(v:nil));
                        FSub[vi.FChar] := vi;    
                    end 
                    vi.seticase(i);
                end     
            end 
        end   
    end 
    function Add(s);
    begin
        return FRoot.Add(s);
    end 
    function Create();
    begin
        fignorecase := false;
        FRoot := new TTireNode();
        FRoot.Ficase := false;
    end 
    function find_node(s,oidx);
    begin
        oidx := 1;
        return  FRoot.find_node(s,length(s),oidx);        
    end 
    function Find(s,slen,idx,outidx,ostr);
    begin
        tid := idx;
        r := FRoot.Find(s,slen,idx);
        if r then 
        begin
            ostr := s[tid:idx-1];
            outidx := idx;
        end 
        idx := tid;
        return r;
    end 
    FRoot;    
    property ignorecase read fignorecase write setignorecase;
    private 
    function setignorecase(i);
    begin
        ni := i?true :false;
        if ni<>fignorecase then 
        begin
            FRoot.seticase(ni);    
        end 
    end 
    fignorecase;
end 
type tpairstate =class //括号状态
    function Create(t);
    begin
        FType := ifstring(t)?t:"";
        FCJ := 0;
        FState := 0;
        FIndexs := array(0);
        FIndex := 0;
        FCstate := false;
        FSubcount := array(0);
    end 
    function subitemadd();
    begin
        FSubcount[FIndex]++;     
    end 
    function subitemcount();
    begin
        return FSubcount[FIndex];
    end 
    function GetLeft();
    begin
        FCstate := true;
        if FState then // 上一个是左括号
        begin 
            FCJ++;
            FIndex++;
            FIndexs[FIndex]:=0;    
        end else //上一个非左括号
        begin         
            FIndexs[FIndex]++;    
            FSubcount[FIndex]:=0;    
        end 
        FState := true;
    end 
    function GetRight();
    begin
        FCstate := true;
        //if FCJ=0 then return ;
        if FState then // 上一个是左括号
        begin 
        
        //FIndexs[FIndex]++;    
        end else //上一个非左括号
        begin 
            if FCJ>0 then 
            begin
                FCJ--;    
                DeleteIndex(FIndexs,FIndex);
                FIndex--;
            end else 
            begin
                FCstate := false;
            end 
        end 
        FState := false;
    end
    function GetSate();
    begin
        if FCstate then 
        begin
            //return inttostr(FIndexs[FCJ])+FType;
            return tostn(FIndexs)+FType;// inttostr(FCJ)+"+"+inttostr(FIndexs[FIndex])+FType; length(FIndexs)+FType ;//
        end
    end
    function Show();
    begin
        echo "层级:",FCJ,"  序号:",FIndexs[FIndex],"状态:", FCstate;
    end 
    property state read FState;
    function Clone();
    begin
        r := new tpairstate(FType);
        r.FCstate := FCstate;
        r.FState := FState;
        r.FCJ := FCJ;
        r.FIndexs := FIndexs;
        r.FIndex := FIndex;
        r.FSubcount := FSubcount;
        return r;
    end
    protected
    FCstate;
    FState;
    FCJ;
    FIndexs;
    FSubcount;
    FIndex;
    FType;

end 
type TIniFileExter=class()
    {**
    @explan(说明) ini文件读写封装 %%
    **}
    private
    FTStringa;
    FVtype;
    FLowerKey;
    FLowerValue;
    function CheckSK(s,k);
    begin
        return ifstring(s) and s and ifstring(k) and k;
    end
    function ChangeV(V);
    begin
        vv := v;
        case Vtype of
            1:vv := vv="0"?false:true;
            2:vv := StrToIntDef(vv,0);
            else
            begin
                if FLowerValue then vv := lowercase(vv);
            end
        end
        return vv;
    end
    function STNVA();
    begin
        {**
        @explan(说明) 转换为name,value 列的二维数组 %%
        **}
        r := array();
        for i := 0 to FTStringa.Count-1 do
        begin
            n := FTStringa.Names(i);
            if n then
            begin
                if FLowerKey then n := lowercase(n);
                vv := FTStringa.Values(n);
                r[length(r)]:= array("name":n,"value":ChangeV(vv));
            end
        end
        FTStringa.Clear();
        return r;
    end
    function STNV();
    begin
        {**
        @explan(说明) 转换为name:value 一维数组 %%
        **}
        nr := STNVA();
        r := array();
        for i,v in nr do
        begin
            r[v["name"]]:= v["value"];
        end
        return r;
    end
    function STA();
    begin
        {**
        @explan(说明) 转换为一维数组 %%
        **}
        r := array();
        for i := 0 to FTStringa.Count-1 do
        begin
            vi := FTStringa.Strings(i);
            r[i]:= FLowerKey?lowercase(vi):vi;
        end
        FTStringa.Clear();
        return r;
    end
    public
    function create();
    begin
        {**
        @explan(说明) 构造函数 %%
        @param(al)(string) 别名 %%
        @param(name)(string) 文件名 %%
        **}
        FTStringa := new TStringlist();
        FAlias := "";
        ffilename := "";
        
    end
    function readSection(sn);virtual;
    begin
        {**
        @explan(说明) 读取section 下面key %%
        **}
        if ifstring(sn)and sn then Fini.readSection(sn,FTStringa);
        return STA();
    end
    function ReadSections();virtual;
    begin
        {**
        @explan(说明) 读取所有section名字 %%
        **}
        FIni.ReadSections(FTStringa);
        return STA();
    end
    function ReadSectionValues(sn);virtual;
    begin
        {**
        @explan(说明) 读取section下面的所有key:value %%
        **}
        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
        return STNV();
    end
    function RenameSection(sn1,sn2);virtual;
    begin
        {**
        @explan(说明) 重命名section %%
        @param(sn1)(string) 旧名字 %%
        @param(sn2)(string) 新名字 %%
        **}
        if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit;
        vs1 := ReadSectionValues(sn1);
        EraseSection(sn1);
        for i,v in vs1 do
        begin
            WriteKey(sn2,i,v);
        end
    end
    function RenameKey(sec,k1,k2);virtual;
    begin
        {**
        @explan(说明) 重命名key %%
        @param(sec)(string) section名称 %%
        @param(k1)(string) 旧名字 %%
        @param(k2)(string) 新名字 %%
        **}
        if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit;
        v := ReadKey(sec,k1);
        DeleteKey(sec,k1);
        WriteKey(sec,k2,v);
    end
    function ReadSectionValues2(sn);
    begin
        {**
        @explan(说明) 获得section 数据,二维表,name,value 列
        **}
        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
        return STNVA();
    end
    function ReadSectionValues3(sn);
    begin
        {**
        @explan(说明) 获得section 数据,二维表,0列为key,1列为value
        **}
        d := ReadSectionValues2(sn);
        r := array();
        for i,v in d do
        begin
            r[length(r)]:= array(v["name"],v["value"]);
        end
        return r;
    end
    function ReadKey(sn,key,def);virtual;
    begin
        {**
        @explan(说明) 读取key %%
        **}
        if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:"");
        return nil;
    end
    function WriteKey(sn,key,v);virtual;
    begin
        {**
        @explan(说明) 写入key %%
        **}
        if ifnil(v)then v := "";
        if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
        return 0;
    end
    function DeleteKey(sn,key);virtual;
    begin
        if CheckSK(sn,key)then return FIni.DeleteKey(sn,key);
    end
    function EraseSection(sn);virtual;
    begin
        {**
        @explan(说明)删除section %%
        **}
        if ifstring(sn)and sn then return FIni.EraseSection(sn);
    end
    function Destroy();virtual;
    begin
        finiobj := nil;
        FTStringa := nil;
    end
    property VType read FVtype write FVtype;
    property LowerKey read FLowerKey write FLowerKey;
    property LowerValue read FLowerValue write FLowerValue;
    property Alias read FAlias write setalias;   //目录别名
    property filename read ffilename write setfilename; //文件名
    _tag;
    private 
    property Fini read getiniobj write finiobj;
    private     
    function getiniobj();
    begin
        if not(finiobj) then 
        begin
            if ifstring(FAlias) and ifstring(ffilename) then 
            begin
                finiobj := new TIniFile(FAlias,ffilename);
            end else 
            begin
                raise "ini读写文件错误";
            end 
        end 
        return finiobj;
    end 
    function setfilename(v);
    begin
        if ifstring(v) and v<>ffilename then 
        begin
            ffilename := v;   
            finiobj := nil; 
        end   
    end 
    function setalias(v);
    begin
        if ifstring(v) and v<>FAlias then 
        begin
            FAlias := v;   
            finiobj := nil; 
        end     
    end 
    FAlias;
    ffilename;
    finiobj;
end
type TCanvsRgnClipAutoSave=class()
    {**
    @expan(说明) 裁剪canvas区域,销毁时还原 %%
    **}
    function Create(cvs,rec);
    begin
        {**
        @explan(说明)构造裁剪对象 %%
        @param(cvs)(tcustomcanvas) canvas 对象 %%
        @param(rec)(array(左上右下))区域 %%
        **}
        if(ifobj(cvs))and cvs.HandleAllocated()and ifarray(rec)then
        begin
            FW32api := cvs._wapi;
            FCvsHandle := cvs.Handle;
            FCrg := FW32api.CreateRectRgn(rec[0],rec[1],rec[2],rec[3]);
            FBKrg := FW32api.SelectClipRgn(FCvsHandle,FCrg); //裁剪区域	
            FBKrg := nil;
        end
    end
    function Destroy();
    begin
        if FW32api and FCvsHandle {and FBKrg} and FCrg then
        begin
            FW32api.SelectClipRgn(FCvsHandle,FBKrg); //恢复区域
            FW32api.DeleteObject(FCrg); //销毁区域
        end
        FW32api := nil;
    end
    private
    FBKrg;
    FCrg;
    FCvsHandle;
    FW32api;
end
type tcountkernel = class() //锁计数对象
    function create();   
    begin
        Flocked := 0;
    end  
    function add();
    begin
        Flocked++;
    end 
    function del();
    begin
        Flocked--;    
    end 
    property locked read Flocked;
    private 
    Flocked;
end 
type tcountlocker = class() //锁对象
    function create(v);
    begin
        if v is class(tcountkernel) then 
        begin 
            fkernel := v;
            fkernel.add();
        end 
    end 
    function destroy();
    begin
        if fkernel then fkernel.del();
    end 
    private 
    fkernel;
end 
//////////////////////字符串文件读取累//////////////////////////////////
type tfileer_rwraw = class() //字符串文件类型
{**
    @explan(说明)字符串文件类型,load save,local_changed_check,data %%
**}
    function create();
    begin
        flen := 0;
        ffilename := "";
        fAlias := "";
        fdatachanged := false;
        inputchanged();
    end 
    function load();//加载
    begin
        if not(ifstring(ffilename) and  fileexists("",ffilename)) then return 0; //文件名不存在
        p := 0;
        len := filesize(fAlias,ffilename);
        tm := filetime(fAlias,ffilename);  
        if not fdatachanged then  //对象数据修改了
        begin 
            if (len=flen) and (tm=floadtime) then return 1; //大小时间没变
        end         
        if 1 = readfile(rwraw(),fAlias,ffilename,p,len,d) then //读文件
        begin
            fdata := d;
            flen := len;
            floadtime := tm;  
            floaded := true;
            fdatachanged := false;
            return 1;
        end
    end 
    function del();//删除
    begin
        if not(ifstring(ffilename) and ffilename)    then return 0;
        if not fileexists(fAlias,ffilename) then return 0;
        r :=  filedelete(fAlias,ffilename)<>1;
        if r then flen := 0;
        return r;
    end 
    function save(); //保存
    begin
        if not(ifstring(ffilename) and ffilename)    then return 0;
        if fileexists(fAlias,ffilename) then 
        begin
            tm := filetime(fAlias,ffilename);  
            if tm=floadtime then return 1;
            sz := filesize(fAlias,ffilename);
            if sz>length(fdata) then 
            begin
                if filedelete(fAlias,ffilename)<>1 then return 0;
                if length(fdata)=0 then
                begin
                    return true;
                end 
            end   else 
            begin
                p := 0;
                if 1 = readfile(rwraw(),fAlias,ffilename,p,sz,d) then
                begin                 
                    if fdata=d then 
                    begin 
                        return 1;
                    end 
                end                     
            end          
        end else 
        begin
            exportfile(ftstring(),fAlias,ffilename,"");
        end 
        if 1=writefile(rwraw(),fAlias,ffilename,0,length(fdata),fdata) then 
        begin
            floadtime := filetime(fAlias,ffilename);
            flen := length(fdata);
            floaded := true;
            fdatachanged := false;
            return true;
        end 
        return false;
    end 
    function local_changed_check(); //本地文件是否从修改后发生改变
    begin
        if floaded then 
        begin 
            if fileexists(fAlias,ffilename) then 
            begin 
                if floadtime<>filetime(fAlias,ffilename) then 
                begin 
                    return 1; //改变
                end 
            end else 
            begin 
                return 2; //删除
            end  
        end        
    end
    property fname read ffilename write setfilename;//文件名
    property Alias read fAlias write fAlias; //目录别名
    property data read getdata write setdata; //数据集
    property ftime read floadtime;//
    property size read flen;//
    private 
    fAlias;
    floadtime;
    ffilename;
    flen;
    fdata;
    fleadload;
    fdatachanged;
    private 
    function getdata();
    begin
        return fdata;        
    end 
    function setdata(s);//设置数据
    begin
        if ifstring(s) and s<>fdata then 
        begin
            inputchanged();
            fdata := s;
            fdatachanged := true;
        end 
    end 
    function setalias(s);
    begin
        if ifstring(s) and s<>fAlias then 
        begin
            fAlias := s;   
            inputchanged();  
        end 
    end 
    function setfilename(f); //修改文件名
    begin
        if f<>ffilename then //文件改变
        begin 
            ffilename := f;   
            inputchanged(); 
        end 
    end 
    function inputchanged();//输入改变
    begin
        fdata := "";  
        flen := 0;  
        floadtime := 0;  
        floaded := false;      
    end 
     
end 
type tinstancemanager = class()
{**
    @explan(说明)函数c语言指针管理器 %%
**}
    function create();
    begin
        fhandles := array();    
    end 
    function destroy();
    begin
        for i,v in fhandles do 
        begin
            deleteinstance(v);
        end 
        fhandles := array();
    end 
    function get(f); //获得
    begin
        {**
        @explan(说明)通过函数句柄获取c回调指针 %%
        @param(f)(handler) tsl函数对象 %%
        @return(pointer) c函数回调 %%
        **}
        id := inttostr(int64(f));
        r := fhandles[id];
        if r then return r;
        r := makeinstance(f);
        if r then 
        begin
            fhandles[id] := r;
            return r;
        end     
    end 
    function del(f);
    begin
        {**
        @explan(说明)通过函数句柄删除c回调指针 %%
        @param(f)(handler) tsl函数对象 %%
        @return(bool) 是否成功 %%
        **}
        id := inttostr(int64(f));
        h := fhandles[id];
        if h then 
        begin
            r := deleteinstance(h);
            reindex(fhandles,array(id:nil));
            return r;
        end 
    end 
    private
    fhandles;
end 
type tstr_step_match=class()
    {**
        @explan(说明)字符串数组匹配 %%
    **}
    private 
    const find_end="end";
    public
    function create(its); //送入匹配的字符串数组
    begin
        fits := array(); 
        fcaches := array(); 
        fcaches[""] := array();      
        set_items(its);
    end 
    function step_find_idx(s:string); //匹配的序号
    begin 
    {**
        @explan(说明)匹配字符串 %%
        @param(s)(string) 匹配的目标 %%
        @return(array of integer) 成功的位置 %%
        **}
        if fcaches[s] then return fcaches[s]; //完全 
        osi := fcaches[""];
        for i:= 1 to length(s) do 
        begin 
            si := s[1:i];
            if fcaches[si] then 
            begin
                osi := fcaches[si];
                continue;
            end             
            osi := get_same_idexs(si,osi); 
            if not ifarray(osi) then osi := array(); 
            fcaches[si] := osi;      
        end 
        return fcaches[s];
    end 
    function step_find(s); //查找匹配的字符
    begin 
        return  fits[step_find_idx(s)];
    end 
    function set_items(its); //设置查找数据
    begin
        if fits<> its and check_legal(its) then 
        begin 
            fits := its;
            fcaches := array();
            fcaches[""] := mrows(fits,1);
        end 
    end 
    function set_init_find_indexs(idxs); //设置初始集合
    begin
        if ifarray(idxs) and idxs<>fcaches[""] then fcaches := array("":idxs);    
    end 
    private 
    function get_same_idexs(si,idxs);virtual; //直接判断全部
    begin
        asi := array();
        asidx := 0;
        for ii,v in idxs do 
        begin
            if checksame(si,v) then 
            begin 
                asi[asidx++] := v;    
            end 
        end 
        return asi;     
    end 
    function checksame(a,b);virtual;//判断相等
    begin 
        return pos(a,fits[ b]);
    end 
    function check_legal(its);virtual; //合法检查
    begin
        return ifarray(its);
    end 
    protected
    fits; //原始数据
    fcaches;
    fcacheslen;
    private     
end 
type t_ini_format_operator=class()
    static const type_section=1;
    static const type_skey=2;
    static const type_value=3;
    function create();
    begin
        fscript := "";
        factidx := 0;
        fscriptlen := 0;
        fdata := array();
        ffirstchar := true;
        fformatdata := array();
    end 
    function read_sections();
    begin
        formatini();
        r := array();
        idx := 0;
        for i,v in  fformatdata do 
        begin
            r[idx++] := v['n'];
        end  
        return r;  
    end 
    function read_section_values(sn);
    begin
        formatini();
        d := fformatdata[lowercase(sn),"d"];
        r := array();
        if d then 
        begin
            idx := 0;
            for i,v in d do 
            begin
                r[idx++] := v[array('k',"v")];//array("name":v['k'],"value":v["v"]);    
            end 
        end 
        return r;    
    end 
    function read_key(sn,key);
    begin
        formatini();
        d := fformatdata[lowercase(sn),"d",lowercase(key),"v"];
        return d;
    end 
    function write_key(sn,key,v);
    begin
        formatini();
        d := fformatdata[lowercase(sn)];
        if d then 
        begin
            info := fformatdata[lowercase(sn),"d",lowercase(key)] ;
            if info then 
            begin
                s := fscript;
                s[info["b"]:info["e"]] := formatkv(key,v);
                //script := s;
                setscript(s);
            end else 
            begin
                s := fscript;
                s[d["e"]:-1] := "\r\n"+formatkv(key,v);
                //script := s;
                setscript(s);
            end    
        end else 
        begin
            s := "["+sn+"]\r\n"+formatkv(key,v)+"\r\n"+fscript;
            //script := s; 
            setscript(s);           
        end 
    end 
    function delete_key(sn,key);
    begin
        formatini();
        info := fformatdata[lowercase(sn),"d",lowercase(key)] ;
        if info then 
        begin        
            s := fscript;
            s[info["b"]:info["e"]] := "";
            setscript(s);  
        end     
    end 
    function delete_section(sn); //移除
    begin
        formatini();
        d := fformatdata[lowercase(sn)];
        if d then 
        begin
            b := d["b"];
            e := d["e"];
            s := fscript;
            s[b:e]:="";
            setscript(s);
        end 
    end 
    function rename_section(sn1,sn2);
    begin
        formatini();
        d := fformatdata[lowercase(sn1)];
        if d then 
        begin
            s := fscript;
            s[d["b"]:d["e2"]]:= "["+sn2+"]";
            setscript(s);
        end     
    end 
    function rename_key(sn,key,nkey);
    begin
        formatini();   
        info := fformatdata[lowercase(sn),"d",lowercase(key)] ; 
        if info then 
        begin
            s := fscript;
            s[info["b"]:info["e"]] := formatkv(nkey,info["v"]);
            setscript(s);    
        end 
    end  
    published
    property script read fscript write setscript;
    private 
    function formatkv(key,v); 
    begin
        return formatstr(key)+"="+formatstr(v);
    end 
    function formatstr(s);
    begin
        if ifstring(s) then s1 := s;
        else s1 := tostn(s);
        s1 := replacetext(s1,"\r","");
        return replacetext(s1,"\n","");
    end 
    function formatini();//获取格式数据
    begin
        parser_ini();
        if not fdata then return ;
        fformatdata := array();
        for i,v in fdata do 
        begin
            d := array();
            for k,kv in v.fdata do 
            begin
                kk := kv[0];
                kkv := kv[1];
                if kk.fb<=kk.fe then 
                begin
                    ks := trim(fscript[kk.fb:kk.fe]);
                    
                end else ks := "";
                if kkv.fb<=kkv.fe then 
                begin
                    ksv := trim(fscript[kkv.fb:kkv.fe]);                    
                end else ksv := "";
                d[lowercase(ks)] := array("k":ks,"v":ksv,"b":kk.fb,"e":kkv.fe);
            end 
            
            fformatdata[lowercase(v.fv)] := array("n":v.fv,"d":d,"b":v.fb,"e":v.fe,"e2":v.fe2);
        end   
        fdata := array();   
    
    end 
    function parser_v();
    begin
        v := new tobjv(type_value,factidx+1);
        while factidx<fscriptlen do 
        begin
            factidx++;
            vi := fscript[factidx]; 
            if vi="\r" or vi="\n" then 
            begin
                v.fe := factidx-1;
                ffirstchar := true;
                return v;
            end          
        end 
        v.fe := factidx;
        return v;
    end 
    function parser_ini();
    begin 
        if factidx>=fscriptlen then return ;   
        k := new tobjv(type_skey,factidx+1);     
        while factidx<fscriptlen do 
        begin
            factidx++;
            vi := fscript[factidx];   
            if ffirstchar then 
            begin 
                case vi of  
                    "[":
                    begin 
                        if fcsection.fv or fcsection.fdata then 
                        begin 
                            fdata[length(fdata)] := fcsection;
                            fcsection.fe := factidx-1;
                        end 
                        fcsection := new tobjv(type_section,factidx);
                        parser_section();       
                    
                    end 
                    "=":
                    begin
                        k.fe := factidx-1;
                        fcsection.add(k,parser_v());
                        k := new tobjv(type_skey,factidx);  
                    end 
                    ";","#": //走到下一行
                    begin
                        gotonextline();
                    end 
                    "\r","\n":
                    begin
                    
                    end else  
                    begin
                        ffirstchar := false;
                        k.fb := factidx;     
                    end 
                end ;
            end  else 
            begin 
                case vi of 
                    "\r","\n":
                    begin
                        ffirstchar := true;   
                        parser_ini(); 
                    end 
                    "=":
                    begin
                        k.fe := factidx-1;
                        fcsection.add(k,parser_v());
                        k := new tobjv(type_skey,factidx);     
                    end 
                end     
            end         
            
            
        end 
        if fdata[length(fdata)-1]<>fcsection then 
            fdata[length(fdata)] := fcsection;
        fcsection.fe := fscriptlen;
    end 
    function parser_section();
    begin
        sn := "";
        while factidx<fscriptlen do 
        begin
            factidx++;
            vi :=  fscript[factidx]; 
            if vi="\r" or vi="\n" then 
            begin
                ffirstchar := true;
                break;
            end 
            if vi="]" then //section 关闭
            begin
                fcsection.fv := trim(sn);
                fcsection.fe2 := factidx;
                ffirstchar := false;
                return parser_ini();
            end 
            sn+=vi;
        end 
    end 
    function gotonextline(); //到达下一行
    begin
        while factidx<fscriptlen do 
        begin
            factidx++;
            vi :=  fscript[factidx] ;
            if vi="\n" then 
            begin 
                ffirstchar := true;
                break;                
            end     
        end 
    end     
    function setscript(s);
    begin
        if ifstring(s) and s<>fscript then 
        begin
            fscript := s;  
            script_init();          
        end 
    end 
    function script_init();
    begin
        fscriptlen := length(fscript);
        factidx := 0;
        fdata := array();
        ffirstchar := true;
        fcsection := new tobjv(type_section,1);
    end 
    fscript;
    fscriptlen;
    factidx;
    fcsection;
    fdata;
    fformatdata;
    ffirstchar;
    type tobjv = class()
        function create(t,b);
        begin
            fb := b;
            fe := -1;
            fv := "";
            ft := t;
            fdata := array();
        end 
        function add(k,v);
        begin
            fdata[length(fdata)] := array(k,v);    
        end 
        fdata;
        fb;
        fe;
        fe2;
        fv;
        ft;    
    end 
end 
type t_gbk_text_finder = class() //查找对象
    function create();
    begin
        ffindstr:="";
        fstr := "";
        Fismline := true;
        findflag := false;
        FisReg := false;
        fiswrap := false;
        fiscase := false;
        fiscycle := true;
        fisprev := false;
        frc := array(1,1);
    end 
    function set_text(s); //文本
    begin
        if fstr<>s then 
        begin 
            fstr := s;
            ftextrows := text_2_array(fstr);
            findflag := true;
        end 
    end 
    function set_replace_str(s);
    begin 
        if frstr<>s then 
        begin 
            frstr := s;
            frstrflag := true;
        end 
    end 
    function set_find_str(s);
    begin
        if ffindstr <> s then 
        begin
            ffindstr := s;
            findflag := true;
        end 
    end 
    function set_rc(rc);  //设置当前行列 1,1 为初始位置
    begin
        if ifarray(rc) and rc[0]>0 and rc[1]>0 then 
        begin 
            frc := rc;
        end 
    end 
    function find_one(); //查找下一个
    begin
        if fisprev then return find_prev();
        return find_next();
    end
    function format_rep_Str(info); //构造替换
    begin
        ms :=get_rep_str_info();
        if ifarray(ms) then 
        begin 
            fr :=frstr;
            for j := length(ms)-1  downto 0 do 
            begin 
                si := fmachs[i,ms[j,3],0];
                if not ifstring(si) then return false; 
                fr[ms[j,1]:ms[j,2]] := si; 
            end 
            return fr;
        end 
        return ms;      
    end 
    function find_all(); //全部查找
    begin
        do_find();
        r := array();
        for i,v in fmachs do 
        begin
            //array(vj,p,pe,array(r1,c1),array(r2,c2),row_text(r1))
            r[i] := format_find_return(v);
        end 
        return r; //返回信息
    end     
    function replace_all(var r);//全部替换,为变参返回,返回结果是行列信息
    begin
        do_find();
        if not fmachs then return 0;
        ms := get_rep_str_info();        
        r := fstr;    
        rinfo := array();  
        for i := length(fmachs)-1 downto 0 do 
        begin 
            info := fmachs[i];
            rs := format_rep_Str(info);
            if rs=0 then return false;
            p1 := info[0,1] ;
            p2 := info[0,2]; 
            r[p1:p2] := rs; 
            rinfo[i] := format_find_return(info);
        end 
        if   r=fstr then  return 0;
        return rinfo;       
    end 
    function find_next();//下一个
    begin
        do_find(); 
        label findtwo;
        for i,v in fmachs do 
        begin 
            if frc[0]<v[0,3,0] or(frc[0]=v[0,3,0] and frc[1]<=v[0,3,1]) then 
            begin
                frc := v[0,4];
                return v;
            end 
        end 
        if not fiscycle then return array();
        if two then return array();
        two := true;
        frc := array(1,1);
        goto findtwo;
    end 
    function find_prev();//上一个
    begin
        do_find();
        label findtwo;
        for i:= length(fmachs)-1 downto 0 do 
        begin 
            v := fmachs[i];
            if frc[0]>v[0,3,0] or(frc[0]=v[0,3,0] and frc[1]>=v[0,4,1]) then 
            begin
                frc := v[0,3];
                return v;
            end        
        end 
        if not fiscycle then return array();
        if two then return array();
        two := true;
        ls := length(ftextrows);
        frc := array(ftextrows[ls-1,0],ftextrows[ls-1,1]);
        goto findtwo;        
    end     
    property isReg read FisReg write set_reg;//正则
    property iscase read fiscase write set_case;//大小写
    property iswrap read fiswrap write set_wrap;//全词匹配
    property iscycle read fiscycle write set_cycle;//循环查找
    property isprev read fisprev write set_prev;//朝前
    property ismline read Fismline write set_mline;//朝前
    private 
    function set_mline(v);
    begin
        nv := v?true:false;
        if nv<>Fismline then 
        begin 
            Fismline := nv; 
            findflag := true;           
        end 
    end 
    function set_prev(v);
    begin
        nv := v?true:false;
        if nv<>fisprev then 
        begin 
            fisprev := nv;           
        end 
    end 
    function set_cycle(v);
    begin
        nv := v?true:false;
        if nv<>fiscycle then 
        begin 
            fiscycle := nv;           
        end 
    end
    function set_reg(v);
    begin
        nv := v?true:false;
        if nv<>fisreg then 
        begin 
            fisreg := nv;
            findflag := true; 
            frstrflag := true;           
        end 
    end 
    function set_case(v);
    begin
        nv := v?true:false;
        if nv<>fiscase then 
        begin 
            fiscase := nv;
            findflag := true;            
        end 
    end
    function set_wrap(v);
    begin
        nv := v?true:false;
        if nv<>fiswrap then 
        begin 
            fiswrap := nv;
            findflag := true;            
        end 
    end
    function row_text(i);//获得行文本
    begin
        return ftextrows[i-1,2];
    end 
    function p_to_rc(p,r,c);//位置到行列
    begin
        r := -1;
        c := -1;
        for i,v in ftextrows do 
        begin 
            if p>=v[0] and p<=(v[1]) then 
            begin 
                r := i+1;c := p-v[0]+1;
                return ;
            end    
        end       
    end 
    function fmt_unreg_ctl(tg,rg,wr);//正则控制串
    begin 
        if not tg then return "";
        ctl := tg;
        if not rg then 
        begin 
            ctl := "";
            ltg := length(tg);
            for i := 1 to length(tg) do 
            begin
                vi := tg[i];
                cvi := ord(vi);
                if cvi>=9 and cvi<=13 then 
                begin
                    ctl +="\\s";
                    if i=1 then wrp :=1;
                    if i=ltg then wrp .|= 2;
                end else 
                if (cvi>=0x21 and cvi<=0x2f) or 
                    (cvi>=0x3a and cvi<=0x40) or 
                    (cvi>=0x5b and cvi<=0x60) or 
                    (cvi>=0x7b and cvi<=0x7e) then 
                begin
                    ctl +="\\"+vi;
                    if i=1 then wrp :=1;
                    if i=ltg then wrp .|= 2;
                end else 
                begin
                    ctl+=vi;
                end                  
            end 
            if wr then 
            begin 
                if not((wrp .& 1) >0) and not((ord(ctl[1]) .& 0x80 )>0) then ctl := "\\b"+ctl;
                if not((wrp .& 2) >0) and not((ord(ctl[length(ctl)]) .& 0x80 )>0) then ctl := ctl+"\\b";
            end 
        end
    
        return ctl;
    end 
    function text_2_array(s); //获得行位置
    begin
        r := array();
        fgf := "\n";
        if pos("\r\n",s) or pos("\n",s) then
        begin
            fgf := "\n";
        end else 
        if pos("\r",s) then 
            fgf := "\r";
        r[0,0] := 1; 
        idx := 0;
        for i := 1 to length(s)-1 do 
        begin
            vi := s[i];
            if vi=fgf then 
            begin
                r[idx,1]:=i;
                r[idx,2]:=s[r[idx,0]:(i-1)];
                idx++;
                r[idx,0] := i+1;                  
            end         
        end
        r[idx,1]:=length(s)+1; 
        r[idx,2]:=s[r[idx,0]:]; 
        return r;
    end
    function do_find();//查找
    begin
        if not findflag then return ;  
        findflag := false;      
        fs := fmt_unreg_ctl(ffindstr,FisReg,fiswrap);
        ctl2 := "";
        if Fismline then ctl2 += "m";
        if fiscase then ctl2+="i";
        fmachs := array();
        frows := array();
        if 1= ParseRegExpr(fs,fstr,ctl2,m,mp,ml) then 
        begin 
            for i ,v in m do 
            begin
                for j,vj in v do 
                begin
                    p := mp[i,j];
                    pe := p+ml[i,j]-1;
                    p_to_rc(p,r1,c1);
                    p_to_rc(pe+1,r2,c2);
                    if j=0 and not(frows[r1]) then 
                    begin
                        frows[r1] := true; 
                        fmachs[i,j] := array(vj,p,pe,array(r1,c1),array(r2,c2),row_text(r1));
                    end else fmachs[i,j] := array(vj,p,pe,array(r1,c1),array(r2,c2));
                end 
            end 
        end 
    end 
      
    function get_rep_str_info(); //替换字符串信息
    begin
        if frstrflag then 
        begin 
            frstrflag := false;
            if frstr then //
            begin 
                if FisReg then //正则表达式 
                begin 
                    if 1= ParseRegExpr("\\$(\\d+)",frstr,"",m,mp,ml) then //占位符计算
                    begin 
                        ms := array();
                        for i:= 0 to length(m)-1 do 
                        begin 
                            ms[i,0] := m[i,0];
                            ms[i,1] := mp[i,0];
                            ms[i,2] := mp[i,0]+ml[i,0]-1;
                            ms[i,3] := strtointdef(m[i,1],0);                    
                        end
                    end else 
                    begin 
                        ms := frstr;  
                    end    
                end else 
                begin 
                    ms := frstr;    
                end         
            end else 
            begin 
                ms := "";
            end
            freginfo := ms; 
        end else 
        begin
            ms := freginfo;
        end  
        return ms;
    end 
    function format_find_return(v); //格式化一个匹配结果
    begin
        r := array();
        r[0] := v[0,0];//匹配结果
        r[1] := v[0,3];//配合开始的行列
        r[2] := v[0,4];//截止的行列
        r[3] := v[0,5];//行内容
        return r;
    end 
    private 
    frstr;
    ffindstr;
    fstr;
    Fismline;
    findflag;    
    frstrflag;
    freginfo;
    fisprev;
    fiscycle;
    FisReg;
    fiscase;
    fiswrap;
    ftextrows;
    fmachs;
    frc;
end 
implementation
////////////////////////////////////////
function Encode_Password(s); //加密
begin
    len := length(s);
    if len<2 then
    begin
        return s;
    end;
    bs := s;
    b := getchar(bs,1);
    for i := 1 to len-1 do
    begin
        b := _xor(getchar(bs,i+1),b);
        bS[i+1] := b;
    end
    bS[1]:= _xor(ord(bs[1]),b);
    return bs;
end;
function Decode_Password(s);//解密
begin
    len := length(s);
    if len<2 then
    begin
        return s;
    end;
    bs := s;
    a := getchar(bs,len);
    bS[1]:= _xor(ord(bs[1]),a);
    for i := len downto 2 do 
    begin
        b := getchar(bs,i-1);
        bS[i]:= _xor(a,b);
        a :=b;
    end
    return bs;
end;
//////////////////////////////////////
function iffuncptr(fn);
begin
    //return datatype(fn)=7;
    return fn and ifobj(fn);
end 
function includestate(u,s);
begin
    {**
    @explan(说明) 状态扩展 %%
    **}
    if not ifarray(u)then u := array();
    if ifarray(s)then u union2= s;
    else u union2= array(s);
    return u;
end
function excludestate(u,s);
begin
    {**
    @explan(说明) 状态缩减%%
    **}
    if not ifarray(u)then u := array();
    if ifarray(s)then u minus= s;
    else u minus= array(s);
    return u;
end
	//*************makelong*****************************
function makelong(low,high,ptrl);
begin
    {**
    @explan(说明) 合并高低为 %%
    @return(integer)  整数 %%
    @param(low)(integer)  低位 %%
    @param(high)(integer)  高位 %%
    @param(ptrl)(integer)  长度 默认为 8 %%
    **}
    if not ifnumber(ptrl)then ptrl := 16;
    mask := 2^(ptrl)-1;
    low1 := low .& mask;
    high1 := high .& mask;
    return _shl(high1,ptrl).| low1;
end

function makeposition(x,y);
begin
    {**
    @explan(说明)将x,y构造为一个int类型 %%
    @return(integer)
    **}
    if ifnumber(x)and ifnumber(y)then return makelong(signedtounsigned(x),signedtounsigned(y));
    return 0;
end
function lowuperdword(value_,lvalue,uvalue,ptrl);
begin
    {**
    @explan(说明) 高低位获取 %%
    @param(value_)(integer)  整数 %%
    @param(lvalue)(integer)  低位 %%
    @param(uvalue)(integer)  高位 %%
    @param(ptrl)(integer)  长度 默认为 8 %%
    **}
    lvalue := uvalue := 0;
    if not ifnumber(value_)then return array(0,0);
    if not ifnumber(ptrl)then ptrl := 16;
    value :=(value_);
    mask := 2^(ptrl)-1;
    uvalue := _shr(value,ptrl).& mask;
    //t := _shl(value,ptrl);
    //lvalue := _shr(t,ptrl) .& mask;
    lvalue := value .& mask;
    return array(lvalue,uvalue);
end
function signedtounsigned(v,n);
begin
    {**
    @explan(说明) 符号数转换为无符号数 %%
    @param(v)(integer) 数字 %%
    @param(n)(integer) 有效位数 %%
    @return(integer)
    **}
    if not ifnumber(n)then n := 16;
    if n>64 then n := 64;
    mkv2 := 1;
    ret := mkv2 .& v;
    for i := 1 to n-1 do
    begin
        mkv2 := _shl(mkv2,1);
        ret +=(mkv2 .& v);
    end
    mkv2 := _shl(mkv2,1);
    if v<0 then
    begin
        ret .|= mkv2;
    end else
    begin
        ret .&=(.! mkv2);
    end
    return ret;
end
function getbitsfrominteger(n,b,e);
begin
    {**
    @explan(说明) 获取数字的位数并转换为整数  %%
    @param(b)(integer) 开始位 %%
    @param(e)(integer) 截止位 %%
    @param(n)(integer) 数字 %%
    @return(integer)
    **}
    r := 0;
    if b<0 then return 0;
    mk := 2^(b);
    for i := b to e do
    begin
        if(mk .& n)>0 then r += _shr(mk,b);
        mk := _shl(mk,1);
    end
    return r;
end

function unsignedtosigned(v,n);
begin
    {**
    @explan(说明) 无符号数转换为符号数 %%
    @param(v)(integer) 数字 %%
    @param(n)(integer) 有效位数 %%
    @return(integer)
    **}
    if not ifnumber(n)then n := 16;
    if n>64 then n := 64;
    mkv := 0;
    mkv := _shl(1,n-1);
    mkv2 := 1;
    for i := 1 to n-1 do
    begin
        mkv2 := _shl(mkv2,1);
        mkv2 += 1;
    end
    vv := v .& mkv2;
    if(v .& mkv)then
    begin
        return 0-((_not(vv) .& mkv2)+1);
    end
    return vv;
end
function bitcombination(s,v,f);
begin
    {**
    @explan(说明)bit位组合 %%
    @param(s)(integer) 原有值 %%
    @param(v)(integer) 追加或者删除 %%
    @param(f)(integer) 0 为 or ,1 为 and ;2 表示 删除 v的值  %%
    **}
    if not(ifnumber(s)and ifnumber(v))then return 0;
    case f of
        0:return s .| v;
        1:return s .& v;
        2:return(.!v).& s;
        else return s;
    end
    hv :=((s .& v)=v);
    if(hv)and f=2 then
    begin
        return(.!v).& s;
    end else
    if(f=0)and not(hv)then
    begin
        return s .| v;
    end else
    if(f=1)and not(hv)then
    begin
        return s .& v;
    end else
    return s;
end
function formatshortcut(d);
begin
    r := "";
    if d then 
    begin
        if d["c"] then r +=(r)?"+Ctrl":"Ctrl";
        if d["s"] then r +=(r)?"+Shift":"Shift";
        if d["a"] then r +=(r)?"+Alt":"Alt";
        if d["f"] then r +=(r)?("+"+d["f"]):d["f"]; 
        if d["w"] then r +=(r)?("+"+d["w"]):d["w"];             
    end 
    return r;    
end 
function parsershortcutstr(s_); //快捷键解析
begin
    s := uppercase(s_);
    ls := length(s);
    zmb := array();
    fb := array();
    for i := 65 to 90 do zmb[chr(i)] := true;
    for i:= 1 to 12 do fb["F"+inttostr(i)] := true;
    cword :="";
    i := 1;
    r := array();
    while(i<=ls) do 
    begin
        vi := s[i];
        vio := ord(vi);
        case vio of 
            65 to 90 ,48 to 57:
            begin
                cword +=vi;
            end
            else 
            begin
                if cword then 
                begin
                    case cword of 
                        "SHIFT":
                        begin
                            r["s"] := true;    
                        end 
                        "CTRL":
                        begin
                            r["c"] := true;
                        end 
                        "ALT":
                        begin
                            r["a"] := true;
                        end 
                        else 
                        begin
                            
                            if fb[cword] and not(r["w"]) then 
                            begin
                                r["f"] := cword;
                            end  else 
                            if r and not(r["f"])  then 
                            begin
                                if zmb[cword] then r["w"] := cword;    
                            end 
                        end 
                    
                    end ;
                end 
                cword := "";
            end  
        
        end;
        i++;
    end  
     if cword then 
    begin
        case cword of 
            "SHIFT":
            begin
                r["s"] := true;    
            end 
            "CTRL":
            begin
                r["c"] := true;
            end 
            "ALT":
            begin
                r["a"] := true;
            end 
            else 
            begin
                if fb[cword] and not(r["w"]) then 
                begin
                    r["f"] := cword;
                end  else 
                if r and not(r["f"]) then 
                begin
                    if zmb[cword] then r["w"] := cword;    
                end 
            end 
        
        end ;
    end 
    if not(r["w"] or r["f"]) then r := array();
    return r;
end 
function FormatTslData(d,sj,tn);
begin
    {**
    @explan(说明) 格式化tsl数据 %%
    @param(d)(any) tsl数据 %%
    @param(sj)(string) 空格距离 %%
    @param(tn)(nil) 空参数 %%
    @return(string) 格式化后的字符串 %%
    **}
    r := "";
    if not(sj and ifstring(sj))then sj := "   ";
    if ifarray(d)then
    begin
        r := "(\r\n";
        if ifnil(tn)then
        begin
            tn := 0;
            r := "array(\r\n";
        end
        di := 0;
        len := length(d);
        for i,v in d do
        begin
            bt := sj;
            if di <> i then
            begin
                bt += tostn(i)+":";
            end
            di++;
            vr := FormatTslData(v,sj,1);
            if len>di then vr += ",";
            r += bt;
            if ifarray(v)then
            begin
                vrs := str2array(vr,"\r\n");
                dii := 0;
                for j,vj in vrs do
                begin
                    if dii<1 then r += vj;
                    else r += sj+vj;
                    r += "\r\n";
                    dii++;
                end
            end else
            r += vr+"\r\n";
        end
        r += ")";
        return r;
    end else
    return tostn(d);
end

function DeleteItemsByIndexs(r,dxs);
begin
    {**
    @explan(说明) 删除数组下标, %%
    @param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%;
    **}
    if not ifarray(r)then exit;
    rdx := array();
    for i,v in dxs do rdx[v]:= nil;
    return reindex(r,rdx);
end
function HexHash();
begin
    c := array("A","B","C","D","E","F");
    idxs := inttostr(0 -> 9)union c union lowercase(c);
    r := array();
    for i,v in idxs do
    begin
        if i<16 then r[v]:= i;
        else r[v]:= i-6;
    end
    return r;
end
function TslToHexStr(t);
begin
    {**
    @explan(说明) 将tsl数据转换为16进制字符串 %%
    @param(t)(any) 任意的tsl数据 %%;
    @return(string) 16进制字符串 %%
    **}
    r := "";
    str := tostm(t,0,1);
    ky := static(inttostr(0 -> 9)union array("A","B","C","D","E","F"));
    idx := 1;
    setlength(r,length(str)* 2);
    for i := 0 to length(str)-1 do
    begin
        vi := ord(str[i]);
        //r += ky[_shr(vi,4) .& 0xf];
        //r +=  ky[vi .& 0xf]  ;
        r[idx]:= ky[_shr(vi,4).& 0xf];
        r[idx+1]:= ky[vi .& 0xf];
        idx += 2;
    end
    return r;
end

function HexFormatStrToTsl(hex);
begin
    {**
    @explan(说明)将带有换行符的16进制字符串转换为tsl数据 %%
    @param(hex)(string) 16进制字符串 %%
    @return(any) tsl数据类型 %%
    **}
    r := "";
    hs := static HexHash();
    //rs := inttostr(0 -> 9)union array("A","B","C","D","E","F","a","b","c","d","e","f");
    for i := 1 to length(hex) do
    begin
        ri := hex[i];
        if hs[ri]>=0 then
        begin
            r += ri;
        end
    end
    return HexStrToTsl(r);
end
function TslToHexFormatStr(tsl);
begin
{**
    @explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %%
    @param(tsl)(any) tsl基础类型%%
    @return(string) 字符串形式的16进制 %%
**}
    s := TslToHexStr(tsl);
    r := "";
    n := length(s);
    i := 1;
    bc := 64;
    while true do
    begin
        if i>n then break;
        ij := i+bc;
        if ij>n and i <= n then
        begin
            r += s[i:n];
            break;
        end else
            r += s[i:ij];
        if ij>n then break;
        r += "\r\n";
        i := ij+1;
    end
    return r;
end
function HexStrToTsl(hex);
begin
    {**
    @explan(说明)16进制字符串转换为tsl数据 %%
    @param(hex)(string) 16进制字符串 %%
    @return(any) tsl数据类型 %%
    **}
    if not(hex and ifstring(hex)) then return nil;
    r := tostm(nil);
    setlength(r,Integer(length(hex)/2));
    hs := static HexHash();
    idx := 0;
    for i := 1 to length(hex)-1 step 2 do
    begin
        vi := hs[hex[i]]; 
        vi1 := hs[hex[i+1]]; 
        r[idx]:= _shl(vi,4).| vi1;
        idx++;
    end
    return stm(r);
end
function gettemppath();
begin
    {**
    @explan(说明)获取windows临时目录 %%
    @return(string) 目录;
    **}
    {$ifdef linux}
    return "/var/tmp/";
    {$endif}
    s := "";
    n := 1024;
    setlength(s,n);
    s1 := s;
    GetTempPathA(n,s);
    GetLongPathNameA(s,s1,n);
    r := "";
    for i := 1 to n do
    begin
        vi := s1[i];
        if vi="\0" then
        begin
            return s1[1:(i-1)];
        end
    end
    return "";
end
function TSL_ReservedKeys(var buf:string;buflen:integer):integer;cdecl;external{$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TSL_ReservedKeys";
function TSL_ReservedKeys2();
begin
    ks := "";
    setlength(ks,1024 * 10);
    TSL_ReservedKeys(ks,length(ks)-1);
    r := array();
    rl := 0;
    ki := "";
    for i := 1 to length(ks)-1 do
    begin
        vi := ks[i];
        if vi="\0" then break;
        if vi="\n" then
        begin
            if ki then
            begin
                r[rl++]:= ki;
                ki := "";
            end
        end else
        ki += vi;
    end
    return r union2 array("read","write"); //添加read write 关键字
end
function GetLongPathNameA(var s1:string;var s:string;L:integer):integer;stdcall;external "Kernel32.dll"  name "GetLongPathNameA";
function GetTempPathA(L:integer;var s:string):integer;stdcall;external "Kernel32.dll"  name "GetTempPathA";
function ParserCommandLine(s); //解析命令行参数
begin
    r := array();
    if not ifstring(s) then return r;
    len := length(s);
    p := "";        
    while idx<len do 
    begin
        idx ++;
        vi := s[idx];
        if vi = '"' then 
        begin 
            if p then r[length(r)] := p;
            p := "";
            while idx<len do 
            begin 
                idx++;
                vi := s[idx];
                if vi = '"' then 
                begin 
                    r[length(r)] := p;
                    p := "";
                    break;
                end 
                p+=vi;
                
            end 
        
        end else 
        if vi=" " or vi="\t" then 
        begin
            if p then r[length(r)] := p;
            p := "";
        end else 
            p+=vi;
    end 
    if p then r[length(r)] := p;
    return r;    
end 
function intersectrect(rec1,rec2,irec);
begin
    {**
    @explan(说明) 计算矩形的交集 %%
    @param(rec1)(array of integer) 矩形区域 %%
    @param(rec2)(array of integer) 矩形区域 %%
    @param(irec)(var array of integer) 重叠的区域 %%
    @return(bool)
    **}
    if lineintersect(array(rec1[0],rec1[2]),array(rec2[0],rec2[2]),d1)and lineintersect(array(rec1[1],rec1[3]),array(rec2[1],rec2[3]),d2)then
    begin
        irec := array(d1[0],d2[0],d1[1],d2[1]);
        return true;
    end
    return 0;
end


function pointinrect(p,rec);
begin
    {**
    @explan(说明) 判断点是否在矩形中 %%
    @param(rec)(array of integer) 矩形区域 %%
    @param(p)(array of integer) 点 array(x,y) %%
    @return(bool)
		
    **}
    x := p[0];
    y := p[1];
    return x>rec[0]and y>rec[1]and x<rec[2]and y<rec[3];
end
function lineintersect(xx1,xx2,xx);
begin
    if(xx1[0]>xx2[0]and xx1[0]>xx2[1])or(xx2[0]>xx1[1]and xx2[1]>xx1[0])then return 0;
    xx := array(max(xx1[0],xx2[0]),min(xx1[1],xx2[1]));
    return 1;
end
function leapyear(y); //闰年判断
begin
    if not(y mod 4) then 
    begin
        if not(y mod 100) then 
        begin
            return not(y mod 400);
        end 
        return 1;
    end 
    return 0;
end 
function getmonthdates(y,m); //获得所在月的天数
begin    
    if m = 2 then  return leapyear(y)+  28;
    if m in array(1,3,5,7,8,10,12) then return 31;
    return 30;  
end 
function CallMessgeFunction(f,o,e);
begin
    {**
    @ignore(忽略)
    **}
    if iffuncptr(f) then return call(f,o,e);
end
function CheckArrayIsNumbers(Value,n);
begin
    if not(ifnumber(n)and n >= 1)then n := 4;
    if ifarray(Value)then
    begin
        for i := 0 to n-1 do
        begin
            if not(ifnumber(Value[i]))then return 1;
        end
        return 0;
    end
    return 1;
end
function CheckArrayIsControlRect(Value);
begin
    {**
    @explan(说明) 检查数组是否可以作为control的rect %%;
    **}
    if not(CheckArrayIsNumbers(Value,4))then
    begin
        return Value[3]>0 and Value[2]>0;
    end
end
function CheckArrayIsControlBounds(Value);
begin
    {**
    @explan(说明) 检查数组是否可以作为control 的 bounds 
    **}
    if not(CheckArrayIsNumbers(Value,4))then
    begin
        return(Value[3]>Value[1])and(Value[2]>Value[0]);
    end
end

function intasposition(i);
begin
    if ifnumber(i)then
    begin
        return lowuperdword(i);
    end
    return array(0,0);
end
function DeleteAllFiles(path);
begin
    {**
    @explan(说明) 删除指定路径的文件或者文件夹 %% 
    **}
    if not ifstring(path)then return 0;
    if not path then return 0;
    iofp := ioFileseparator();
    if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
    info := FileList("",path); //"A"
    if info then
    begin
        if pos("D",info[0]["Attr"])then
        begin
            fs := FileList("",path+iofp+"*");
            for i,v in fs do
            begin
                n := v["FileName"];
                if n in array(".","..")then continue;
                call(thisfunction,path+iofp+n);
            end
            return RemoveDir("",path);
        end else
        begin
            return FileDelete("",path);
        end
        return 0;
    end
end
function CreateDirWithFileName(fname);
begin
    {**
    @explan(说明) 根据文件全名构造目录 %%
    **}
    if not(ifstring(fname)and(length(fname)>4))then exit;
    info := FileList("",fname);
    if info then exit;
    len := length(fname);
    iofp := ioFileseparator();
    for i := len downto 1 do
    begin
        vi := fname[i];
        if vi=iofp then
        begin
            ffname := fname[1:i];
            break;
        end
    end
    if not ffname then exit;
    ffL := length(ffname);
    {$ifdef linux}
    nct := 1;
    if ffL<1 then exit;
    {$else}
    nct := 4;
    if ffL<4 then exit;
    {$endif}    
    ph := ffname[1:nct];
    for i := nct+1 to ffL do
    begin
        vi := ffname[i];
        if vi=iofp then
        begin
            if not FileList("",ph)then
            begin
                CreateDir("",ph);
            end
        end
        ph += vi;
    end
end
{$ifdef linux}
function TS_GetUserProfileHome();
begin
    home := sysgetenv("HOME");
    if home then bpath := home+"/.vcl/";
    else 
        bpath := ".vcl/";
    return bpath;
end 
{$else}
function TS_GetUserProfileHome():string;cdecl;external  "TSSVRAPI.dll"  name "TS_GetUserProfileHome";
{$endif} 
function TS_GetUserProfileHomeInstance(t:integer):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetUserProfileHomeInstance";
function TS_GetUserConfigHome(t:integer):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetUserConfigHome";
function TS_GetHomePath(t:integer):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetHomePath";
function TS_ModulePath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_ModulePath";
function TS_ExecPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_ExecPath";
function TS_GetAppPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetAppPath";
function TS_GetIniPath(t:integer;iname:string):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetIniPath";
function int_to_binary(d,n); //整数转换成字符串
begin
    r := "";
    x := d;
    ct := 0;
    if not(n>1)then n := 8;
    while x>0 do
    begin
        divmod(x,2,a,b);
        r := inttostr(b)+r;
        x := a;
        ct++;
        if ct >= n then break;
    end
    if ct=0 then
    begin
        ct := 1;
        r := "0";
    end
    for i := ct to n-1 do
    begin
        r := "0"+r;
    end
    return r;
end
function rec_inc(rec,n);
begin
    r := rec;
    r[0]+=n;
    r[1]+=n;
    r[2]-=n;
    r[3]-=n;
    if r[2]<r[0] then r[2] := r[0];
    if r[3]<r[1] then r[3] := r[1];
    return r;
end 
function istextascii(s); //ansi编码
begin
    len := length(s);    
    //m := new TMemoryStream();
    //dp := get_tsl_mem_ptr(s);
    //m.setmemory(dp,len);
    //ci := 0; 
    i := 1;
    for i:= 1 to len do 
    begin 
        ci := ord(s[i]);
        //m.read(ci,1);
        if((ci .& 0x80)<> 0) then return false;
    end 
    return true;
end 
function isTextGBK(data) //gbk编码
begin
    if not ifstring(data) then return 0;    
    i := 1;
    len := length(data);
    while (i <= len) do  
    begin 
        ordi := ord(data[i]);
        if (ordi <= 0x7f) then 
        begin 
            //编码小于等于127,只有一个字节的编码，兼容ASCII
            i++;
            continue;
        end else 
        begin 
            ordi2 := ord(data[i + 1]);
            //大于127的使用双字节编码
            if  (ordi >= 0x81 and
                ordi <= 0xfe and 
                ordi2 >= 0x40 and 
                ordi2 <= 0xfe and 
                ordi2 <> 0x7f) then 
                begin 
                i += 2;
                continue;
            end else 
            begin 
                return false;
            end 
        end 
    end 
    return true;
end
function IsTextUTF8(str)
begin
    {utf8规则
    单字节: 0xxxxxxx
    二字节  110xxxxx 10xxxxxx
    三字节  1110xxxx 10xxxxxx 10xxxxxx
    四字节  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
    五字节  111110xx  10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
    六字节  1111110x  10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
    }
    // 0 为ansi 编码,1 为utf8编码 -1 不能确定什么编码
    nBytes := 0; //UFT8可用1-6个字节编码,ASCII用一个字节
    DY := 0;
    chr := "";
    bAllAscii := TRUE; //如果全部都是ASCII, 说明不是UTF-8
    for i := 1 to length(str) do
    begin
        chr := ord(str[i]);
        if((chr .& 0x80)<> 0)then
        begin // 判断是否ASCII编码,如果不是,说明有可能是UTF-8,ASCII用7位编码,但用一个字节存,最高位标记为0,o0xxxxxxx
            bAllAscii := FALSE;
        end
        if(nBytes=0)then //如果不是ASCII码,应该是多字节符,计算字节数
        begin
            if(chr >= 0x80)then
            begin
                if(chr >= 0xFC and chr <= 0xFD)then nBytes := 6;
                else if(chr >= 0xF8)then nBytes := 5;
                else if(chr >= 0xF0)then nBytes := 4;
                else if(chr >= 0xE0)then nBytes := 3;
                else if(chr >= 0xC0)then nBytes := 2;
                else return 0;
                DY := MAX(nBytes,DY);
                nBytes--;
            end
        end else //多字节符的非首字节,应为 10xxxxxx
        begin
            if((chr .& 0xC0)<> 0x80)then return -1;
            nBytes--;
        end
    end;
    //违返规则
    if(nBytes>0)then 
        return -1;
    //如果全部都是ASCII, 说明不是UTF-8
    if(bAllAscii)then 
        return 0;
    //return 1;
    return DY>=2;
end


function exportjsonformat(d,tbw,ct);
begin
    //d:天软数据
    //tbw : 字符串,tab 宽度
    //ct 递归深度,忽略
    case datatype(d) of
        0,20:return inttostr(d);
        1:return floattostr(d);
        2:return tostn(d);
        8,10,11,12:return "null";
    end;
    if not(ct>0)then ct := 0;
    if not ifstring(tbw)then tbw := "   ";
    tbstr := "";
    tbstra := "";
    for i := 0 to ct do
    begin
        tbstr += tbw;
        if i>0 then tbstra += tbw
    end
    if ifarray(d)then
    begin
        if not d then return "[]";
        idx := 0;
        for i,v in d do
        begin
            if idx <> i then
            begin
                fobj := true;
                break;
            end
            idx++;
        end
        if fobj then
        begin
            r := "{";
            for i,v in d do
            begin
                if ifstring(i)then ii := tostn(i);
                else ii := tostn(tostn(i));
                r += "\r\n"+tbstr+ii+":";
                if ifarray(v)and v then
                begin
                    r += "\r\n"+tbstr;
                end
                r += exportjsonformat(v,tbw,ct+1)+",";
            end
            lr := length(r);
            r[lr:]:= "\r\n"+tbstra+"}";
        end else
        begin
            r := "[";
            for i,v in d do
            begin
                r += "\r\n"+(tbstr)+exportjsonformat(v,tbw,ct+1)+",";
            end
            lr := length(r);
            r[lr:]:= "\r\n"+tbstra+"]";
        end
        return r;
    end else
    if ifobj(d)then
    begin
        try
            //return "{}";
            //此处可以遍历对象信息
            tslobjtoarray(d,dinfo);
            for i,v in mrows(dinfo,1) do
            begin
                nv := invoke(d,v);
                if ifobj(nv)then nv := nil; //避免死循环
                dinfo[v]:= nv;
            end
            return exportjsonformat(dinfo,tbw,ct);
        except
            return "{}";
        end
    end else
    return "null";
end
function tslobjtoarray(o,r);
begin
    d := o.classinfo();
    if not ifarray(r)then r := array();
    for i,v in d["inherited"] do
    begin
        tslobjtoarray(findclass(v,o),r);
    end
    for i,v in d["members"] do
    begin
        n := v["name"];
        if v["access"]in array(0,1)then
        begin
            r[n]:= 0;
        end else
        begin
            reindex(r,array(n:nil));
        end
    end
    for i,v in d["properties"] do
    begin
        n := v["name"];
        if v["read"]and(v["access"]in array(0,1))then
        begin
            r[n]:= 0;
        end else
        begin
            reindex(r,array(n:nil));
        end
    end
end
function gettslexefullpath();
begin
    plg := pluginpath(); 
    sp := ioFileseparator();   
    for i:= length(plg)-1 downto 1 do 
    begin
        if plg[i]=sp then 
        begin
            if sp="/" then 
            begin 
                return plg[1:i]+"TSL";
            end else 
            begin
                return plg[1:i]+"tsl.exe";
            end 
        end 
    end 
    return "";
end  
function  get_resource_by_name(n,full);
begin
    return static get_resource_by_name_sub(n,full) name (n$":"$full);
end 
function get_resource_by_name_sub(n,full);
begin
    global g_w_tfm_resource,g_w_tfm_resource_withdir,g_w_tfm_resource_names;
    if n=1 then return g_w_tfm_resource;
    if n=2 then return g_w_tfm_resource_withdir;
    if n=3 then return (g_w_tfm_resource union g_w_tfm_resource_withdir);
    if n=4 then return g_w_tfm_resource_names;
    //p := filesize("","d:\\test\\get_source.txt");

    r := g_w_tfm_resource[n];  
    if r then return r;
    if full then 
    begin 
        return g_w_tfm_resource_withdir[n];        
    end 
    if not(ifstring(n) and n) then return 0;
    for i,v in g_w_tfm_resource_withdir do 
    begin 
        nn := replacetext(n,".","\\.");
        {$ifdef linux}
            ctl := "/"+nn+"$|^"+nn+"$";
        {$else}
            ctl := "\\\\"+nn+"$|^"+nn+"$";
        {$endif}         
        if 1= parseregexpr(ctl,i,"i",m,mp,ml) then 
        begin 
            return v;
            
        end 
    end 
end 
function uinit();
begin
    global g_w_tfm_resource,g_w_tfm_resource_withdir,g_w_tfm_resource_names;
    sep := ioFileseparator();
    g_w_tfm_resource := array();
    g_w_tfm_resource_withdir := array();
    g_w_tfm_resource_names := array();
    idx := 0;
    try
        getglobalcache("@@tsl-resource@@",rs);
        for i,v in rs do 
        begin
            if ifstring(i) and ifstring(v) then 
            begin                
                li := lowercase(i);
                g_w_tfm_resource_names[i] := li;
                if pos(sep,li) then 
                begin 
                    g_w_tfm_resource_withdir[li] := v;    
                end else 
                begin 
                    g_w_tfm_resource[li] := v;
                end 
            end 
        end 
    except        
    end 
end  
function get_tsl_mem_ptr(s,n);
begin
    ptr := static makeinstance(thisfunction(get_tsl_ptr_drift));
    if ifwstring(s) then 
    begin
        _f_ := static function(var v:widestring;n:integer):pointer;cdecl;external ptr;
    end else 
    if ifstring(s) then 
    begin 
        _f_ := static function(var v:string;n:integer):pointer;cdecl;external ptr;
    end else 
    if ifint(s) then 
    begin
        _f_ := static function(var v:integer;n:integer):pointer;cdecl;external ptr;
    end else 
    if ifint64(s) then 
    begin
        _f_ := static function(var v:int64;n:integer):pointer;cdecl;external ptr;
    end else 
    if ifnumber(s) then 
    begin
        _f_ := static function(var v:double;n:integer):pointer;cdecl;external ptr;
    end else 
    if ifobj(s) then 
    begin
        _f_ := static function(var v:TObject;n:integer):pointer;cdecl;external ptr;
    end 
    return call(_f_,s,((n>0)?n:0));
end 
{function tsl_str_head_at(s,n);
begin
    _f_ := static function(var v:string;n:integer):string;cdecl;external makeinstance(thisfunction(get_tsl_ptr_drift));  
    return ##_f_(s,n);     
end }
function get_tsl_ptr_drift(v:pointer;n:integer):pointer;cdecl;
begin
    if n>0 then return v+n;
    return v;
end 
function complementary_color(c);//补色计算
begin
    return rgb((255-GetRValue(c)),(255-GetgValue(c)),(255-GetbValue(c)));
end 

initialization
uinit();
end.

//////////////////////暂时没用到的类型///////////////////////////////////////
(*

type TFileLocker=class()
    {**
    		@ignore(忽略) %%
    		@explan(说明) 文件锁定 %%
    	**}
    private
    FHandle;
    FLocked;
    FApi;
    function GetFileOpen();
    begin
        return FHandle <> 0;
    end
    function GetFileLocked();
    begin
        return FLocked <> 0;
    end
    public
    function Create(F);
    begin
        {**
    			@explan(说明)对文件加锁,防止其他进程读写 %%
    			@param(f)(string) 文件名 %%
    		**}
        FHandle := 0;
        FLocked := 0;
        if not FileExists("",f)then exit;
        FApi := gettswin32api();
        FHandle := FApi.CreateFileA(F,0x40000000L,0,0,3,0x00000080,0);
        if not FHandle then exit;
        FLocked := FApi.LockFile(FHandle,0,0,0,0);
    end
    function Destroy();
    begin
        if FLocked then
        begin
            FApi.UnlockFile(FHandle,0,0,0,0);
        end
        if FHandle then
        begin
            FApi.CloseHandle(FHandle);
        end
    end
    property FileOpend read GetFileOpen;
    property FileLocked read GetFileLocked;
    {**
    			@param(FileOpend)(bool) 是否有效%%
    			@param(FileLocked)(bool) 是否已经锁定%%
    		**}
end  


type Ttagaccel=class(tslcstructureobj)
    private
    static SSTRUCT;
    class function getstruct()
    begin
        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
                ("fvirt","byte",0),
                ("key","short",0),
                ("cmd","short",0)));
        return SSTRUCT;
    end
    public
    function create(ptr)
    begin
        inherited create(getstruct(),ptr);
    end
    property fvirt index "fvirt" read _getvalue_ write _setvalue_;
    property key index "key" read _getvalue_ write _setvalue_;
    property cmd index "cmd" read _getvalue_ write _setvalue_;
end
type TBITMAPINFOHEADER=class(tslcstructureobj)
    private
    static SSTRUCT;
    class function getstruct()
    begin
        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
                ("bisize","int",40),
                ("biwidth","int",0),
                ("biheight","int",0),
                ("biplanes","short",0),
                ("bibitcount","short",0),
                ("bicompression","int",0),
                ("bisizeimage","int",0),
                ("bixpelspermeter","int",0),
                ("biypelspermeter","int",0),
                ("biclrused","int",0),
                ("biclrimportant","int",0)
            ));
        return SSTRUCT;
    end
    public
    function create(ptr)
    begin
        inherited create(getstruct(),ptr);
        bisize := _size_();
    end
    property bisize index "bisize" read _getvalue_ write _setvalue_;
    property biwidth index "biwidth" read _getvalue_ write _setvalue_;
    property biheight index "biheight" read _getvalue_ write _setvalue_;
    property biplanes index "biplanes" read _getvalue_ write _setvalue_;
    property bibitcount index "bibitcount" read _getvalue_ write _setvalue_;
    property bicompression index "bicompression" read _getvalue_ write _setvalue_;
    property bisizeimage index "bisizeimage" read _getvalue_ write _setvalue_;
    property bixpelspermeter index "bixpelspermeter" read _getvalue_ write _setvalue_;
    property biypelspermeter index "biypelspermeter" read _getvalue_ write _setvalue_;
    property biclrused index "biclrused" read _getvalue_ write _setvalue_;
    property biclrimportant index "biclrimportant" read _getvalue_ write _setvalue_;
end
type TTBBUTTONINFOA=class(tcstructwithcharptr)
    {**
    @explan(说明) 工具条项内存对象 %%
    **}
    private
    static SSTRUCT;
    function getstruct()
    begin
        if not SSTRUCT then SSTRUCT := array(
            ("cbsize","int",0),
            ("dwmask","int",0),
            ("idcommand","int",0),
            ("iimage","int",0),
            ("fsstate","byte",0),
            ("fsstyle","byte",0),
            ("cx","short",0),
            ("lparam","intptr",0),
            ("psztext","char*",0),
            ("cchtext","int",100));
        return SSTRUCT;
    end
    public
    function create();override;
    begin
        inherited create(getstruct(),array("psztext":"cchtext"),nil);
        cbsize := _size_();
    end
    property cbsize index "cbsize" read _getvalue_ write _setvalue_;
    property dwmask index "dwmask" read _getvalue_ write _setvalue_;
    property idcommand index "idcommand" read _getvalue_ write _setvalue_;
    property iimage index "iimage" read _getvalue_ write _setvalue_;
    property fsstate index "fsstate" read _getvalue_ write _setvalue_;
    property fsstyle index "fsstyle" read _getvalue_ write _setvalue_;
    property cx index "cx" read _getvalue_ write _setvalue_;
    property lparam index "lparam" read _getvalue_ write _setvalue_;
    property psztext index "psztext" read _getvalue_ write _setvalue_;
    property cchtext index "cchtext" read _getvalue_ write _setvalue_;
end

type TTBBUTTON=class(tslcstructureobj)
    {**
    @explan(说明) 工具栏按钮内存对象 %%
    **}
    private
    static SSTRUCT;
    function getstruct()
    begin
        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
                ("ibitmap","int",0),
                ("idcommand","int",0),
                ("fsstate","byte",0),
                ("fsstyle","byte",0),
                ("dwdata","intptr",0),
                ("istring","char*",128)));
        return SSTRUCT;
    end
    public
    function create(ptr)
    begin
        inherited create(getstruct(),ptr);
    end
    function _setvalue_(id,v);
    begin
        if id="istring" then
        begin
            if ifstring(v)and length(v)<127 then
            begin
                return inherited;
            end
            return;
        end
        return inherited;
    end
    property ibitmap index "ibitmap" read _getvalue_ write _setvalue_;
    property idcommand index "idcommand" read _getvalue_ write _setvalue_;
    property fsstate index "fsstate" read _getvalue_ write _setvalue_;
    property fsstyle index "fsstyle" read _getvalue_ write _setvalue_;
    property dwdata index "dwdata" read _getvalue_ write _setvalue_;
    property istring index "istring" read _getvalue_ write _setvalue_;
end
type TScrollBarKind=class(tenumeration)
    static sbHorizontal;
    static sbVertical;
end

type TToolTipsFlags=class
    {**
    @ignore(忽略) %%
    @explan() tooltips flags 常量 %%
    **}
    static TTF_IDISHWND;
    static TTF_CENTERTIP;
    static TTF_RTLREADING;
    static TTF_SUBCLASS;
    static TTF_TRACK;
    static TTF_ABSOLUTE;
    static TTF_TRANSPARENT;
    static TTF_PARSELINKS;
    static TTF_DI_SETITEM;
end

	type TIMAGEINFO = class(tslcstructureobj)
			{**
			 @ignore 忽略 %%
				@explan(说明) imgelist中image的信息 %%
			**}
			private
			static SSTRUCT;
			function getstruct()
			begin
				if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(
					array(
					("hbmimage","intptr",0),
					("hbmmask","intptr",0),
					("unused1","int",0),
					("unused2","int",0),
					("rcimage","int[4]",
					(0,0,0,0))));
				return SSTRUCT;
			end
			function getbmp(v);
			begin
			{**
				@explan(说明)构造tbitmap对象 %%
			**}
				hm := _getvalue_(v);
				if hm then 
				begin
					r := new tbitmap();
					r.handle := hm;
					r.AutoDestroy := false;
					return r;
				end 
			end 
			public 
			function create(ptr)
			begin
				inherited create(getstruct(),ptr); 
			end
			property bmimage:tbitmap index "hbmimage" read getbmp write getbmp;
			property bmmask:tbitmap index "hbmmask" read getbmp write getbmp;
			property hbmimage  index "hbmimage" read _getvalue_ write _setvalue_;
			property hbmmask index "hbmmask" read _getvalue_ write _setvalue_;
			property unused1 index "unused1" read _getvalue_ write _setvalue_;
			property unused2 index "unused2" read _getvalue_ write _setvalue_;
			property rcimage index "rcimage" read _getvalue_ write _setvalue_;
			{**
				@param(bmimage)(tbitmap) 位图 %%
				@param(bmmask)(tbitmap) mask %%
				@param(rcimage)(array) 左上右下 %%
			**}
		end

*)


//////////////twincontrol 中移除的函数
(*
		function CreateDrawItemEvent();virtual;
		begin
		{**
			@explan(说明) 主动构造drawitem消息,可以自行填写信息在DoDrawItem中使用,与DestroyDrawItemEvent成对出现 %%
			@return(TMDRAWITEM|nil) item绘制对象 %%
		**}
			e := nil;
			if HandleAllocated()   then 
			begin 
				hd := self.Handle;
				itptr := FTtageDrawItem._getptr_;
				e := new TMDRAWITEM(WM_DRAWITEM,0,itptr,hd);
				e.canvas := canvas;
				canvas.handle := _wapi.GetDC(self.Handle);
			end 
			return e;
		end 
		function DestroyDrawItemEvent(e);virtual;
		begin
		{**
			@explan(说明) 与CreateDrawItemEvent配合使用 %%
			@param(e)(TMDRAWITEM) CreateDrawItemEvent 构造的消息对象 %%
		**}
			if   HandleAllocated() and ( e is class(TMDRAWITEM)) and (e.lparam = FTtageDrawItem._getptr_()) then 
			begin
				dc := canvas.Handle;
				if dc then 
				begin 
					canvas.handle := 0;
					return _wapi.ReleaseDC(self.Handle,dc);
				end 
			end 
		end 
*)

(*
    //tcontrol 移除代码
    function GetDeviceContext(var WindowHandle:HWND);virtual; //type_tcontrol
    begin
        {**
        @explan(说明) 获取设备hdc %%
        @param(WindowHandle)(pointer) 窗口句柄 %%
        @return(pointer) dc 句柄 %%
        **}
        if Parent is class(TWinControl)then
        begin
            Result := Parent.GetDeviceContext(WindowHandle);
            MoveWindowOrgEx(Result,Left,Top);
            IntersectClipRect(Result,0,0,Width,Height);
        end else
        raise "错误";
        return Result;
    end;

		function IntersectClipRect(hdc, x0, y0, x1, y1);virtual; //type_tcontrol
		begin
			_wapi.IntersectClipRect(hdc, x0, y0, x1, y1);
		end 
		function MoveWindowOrgEx(hdc;x:integer;y:integer);virtual; //type_tcontrol
		begin
		{**
			@explan(说明) 移动dc原点 %%
			@param(hdc)(pointer) dc 句柄 %%
		**}
			return _wapi.SetViewportOrgEx(hdc,x,y,nil);	
		end 
		
				function WMXButtonDown(o,e): LM_XBUTTONDOWN;virtual;
		begin
		end 
		function WMMButtonDBLCLK(o,e): LM_MBUTTONDBLCLK;virtual;
		begin
		
		end 
		function WMXButtonDBLCLK(o,e): LM_XBUTTONDBLCLK;virtual;
		begin
		
		end 
		function WMLButtonTripleCLK(o,e): LM_LBUTTONTRIPLECLK;virtual;
		begin
		
		end 
		function WMRButtonTripleCLK(o,e): LM_RBUTTONTRIPLECLK;virtual;
		begin
		
		end 
		function WMMButtonTripleCLK(o,e): LM_MBUTTONTRIPLECLK;virtual;
		begin
		
		end 
		function WMXButtonTripleCLK(o,e): LM_XBUTTONTRIPLECLK;virtual;
		begin
		
		end 
		function WMXButtonUp(o,e): LM_XBUTTONUP;virtual;
		begin
		
		end 
		function WMLButtonQuadCLK(): LM_LBUTTONQUADCLK;virtual;
		function WMRButtonQuadCLK(): LM_RBUTTONQUADCLK;virtual;
		function WMMButtonQuadCLK(): LM_MBUTTONQUADCLK;virtual;
		function WMXButtonQuadCLK(): LM_XBUTTONQUADCLK;virtual;
*)
(*

		function SetMainMenubk(mu);
		begin
			if csDesigning in ComponentState then 
			begin
				if FMainMenu and mu then //已经存在 %%
				begin 
					return ;
				end 
				if (not FMainMenu) and mu then 
				begin 
					mu := new TMainmenu(self); //构造一个假的菜单 
					tm := new TMenu(mu);
					tm.caption := "menu";
					tm.parent := mu;
				end 
			end 
			if  FMainMenu<>mu then 
			begin	
				OM := FMainMenu;
				if OM is class(tmainmenu) then 
				begin
					OM.DestroyHandle(); //删除句柄 %%
					OM.Hwnd := 0;
					//if HandleAllocated() then _wapi.SetMenu(self.Handle,0);	//删除窗口上面的菜单句柄  
				end 
				if (mu is class(tmainmenu)) then 
				begin
					if HandleAllocated() then
					begin
						mu.Hwnd := handle;
						//_wapi.SetMenu(self.Handle,mu.handle);
					end 	
				end 
				FMainMenu := mu;
			end 
		end 
		
		type TTempFile = class
    function Create(dt);
    begin
        if not ifarray(FFiles) then FFiles := array();
        bp :=gettemppath()+"tinysoft"+ioFileseparator()+"tslvcl"+ioFileseparator();
        {if not fileexists("",bp) then 
        begin
            for i:=2 to length(bp) do 
            begin
                if bp[i]=ioFileseparator() then 
                begin
                    if fileexists("",bp[1:i-1]) then 
                    begin
                        createdir("",bp[1:i-1])
                    end 
                end 
            end 
        end }
        for i,v in mrows( FFiles,1) do 
        begin
            if not(FFiles[v]) then 
            begin
                FFiles[v] := true;
                FPath := v;
                break;        
            end 
        end 
        while not FPath do 
        begin
            i := 0;
            while true do 
            begin 
                subdir := tostn( rand(3)[1]);
                p := bp+subdir[3]+ioFileseparator()+subdir[4]+".png";
                echo p,"\r\n";
                if not(FFiles[p]) then 
                begin
                    FFiles[p] := true;
                    FPath := p;
                    //writefile(rwraw(),"",FPath,0,1,"0") ;
                    break;    
                end 
            end 
        end   
        if ifstring(dt) then 
        begin
           //if FileExists("",FPath) then filedelete("",FPath);
           writefile(rwraw(),"",FPath,0,length(dt),dt) ;
        end 
    end 
    function GetData(buf);//获得数据
    begin
        if FPath then 
        begin 
            sz := filesize("",FPath);
    		      return readfile(rwraw(),"",FPath,0,sz,buf);	 
		      end 
    end
    function Destroy();
    begin
        //FFiles[FPath] := false;
        if FileExists("",FPath) then echo "\r\ndeletefile:",filedelete("",FPath);
        FPath := "";
    end 
    property path read FPath ;
    private
    FPath;
    static FFiles;
end 
		
*)
//暂时不用的函数
{function chartoint(c);
begin
    v := ord(c);
    case v of
        48 to 57:vk := v-48;
        65 to 70:vk := v-65+10;
        97 to 102:vk := v-97+10;
        else raise "非16进制字符串";
    end
    return vk;
end}