unit tslvcl;
{**
    @explan(说明) tsl语言可视化组件库库,支持windows以及gtk(linux)%%
    @auther 天软科技  %%
    @date(20220223)
**}
{
    更新说明
    20221111整理代码,实现发现版本
    20220328整理代码
    20200721 修改设计器中属性的显示控制,将属性持久化和设计器分离 
    20200515 整理代码去掉一些不需要使用的代码
    20190612 添加缓存抽象 TCacheItem,TCacheList 对象
    		 固定listview 固定在设计模式下表头宽度
    20191115 删除popup窗口句柄 	
}
///////////平台判断////////
{$ifdef linux}         
    {$define gtkpaint}
    {$define linuxgtk}
{$else}
    {$define gdipaint}
{$endif}
interface
uses utslvclconstant,utslvclbase,utslvclauxiliary,cstructurelib,utslvclmemstruct,utslvclevent,
    UVCPropertyTypesPersistence,utslvclgdi,utslvclaction,utslvclmenu,utslvclstdctl,utslvclpage,
    utslvcldlg,utslvclgrid,utslvcltree,utslvclcoolbar;
function initializeapplication();      //获得app对象
function RegisterComponentType(n,typ); //注册控件,便于通过控件名称构造控件
function GetAndDispatchMessageA(hwnd,minm,maxm); //win32 分发消息
function ExitMessageLoop();                      //退出主循环
//function gettswin32api();                      //win32 api
function NotifyComponent(Sender,Act,ToComponent); //notfiy
//////////////////////操作/////////////////////
Function tslcstructure(data,dsize,pack,ptr);

//function CompareRect(orect,nrect);
function calldatafunction();
function CallMessgeFunction(f,o,e);
//////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err);              //检查tsl语法
//function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序
//function TS_ModulePath();
//function TS_ExecPath();
//function TS_GetAppPath();
function TS_GetUserProfileHome();
//function TS_GetIniPath(hometype,IniName);
function CopyUsedTslDllToNewDir(p);      
/////////////////////////////////////////////
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
//************************
//*******************************
function MessageBoxA(txt,title,flag,hd);
function _timeproc_(hwnd,message,wparam,lparam);//win32消息分发
function _twinproc_(hwnd,message,wparam,lparam);//win32消息分发
function _MessgeHook_a(hwnd,message,wparam,lparam);
function remotetslcallback(data);
//********其他辅助函数*******
function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function GetTextWidthAndHeightWidthFont(s,f,mul);
////////////////////////////////////
{type TByteData = class(TByteDataOP)	
end	}
	//应用
type tapplication=class(tcomponent)
    {**
    @explan(说明) application 窗口 %%
    **}
    private
    static FApplicationWindow;
    static FMessageObj;
    //static Ftooltips;
    FVisible;
    FHandle; //句柄
    Fmainform; //主窗口
    FDebug;
    //FTiptimer;
    //FTiptimertag1;
    Foldforminfo;
    function SetVisible(v);
    begin
        FVisible := v?true:false;
        if FApplicationWindow is class(TWinControl)then
        begin
            FApplicationWindow.visible := FVisible;
        end
    end
    function SetMainForm(f);
    begin
        if not(f is class(TVCForm))then exit;
        if f=Fmainform then exit;
        if Fmainform then
        begin
            odf := Fmainform;
            odf.onclose := Foldforminfo["close"];
            odf.OnMinimize := Foldforminfo["minimize"];
        end
        Fmainform := f;
        //{$ifdef linuxgtk}
        //{$else}			
        if not(FApplicationWindow)then initialize();
        if not(f.HandleAllocated())then
        begin
            f.parent := FApplicationWindow;
        end
        IC := f.FormIcon;
        if(ic is class(tcustomicon))and ic.HandleAllocated then
        begin
            FApplicationWindow._send_(WM_SETICON,1,ic.handle,1);
        end
        FApplicationWindow.caption := f.caption;
        //{$endif}
        Foldforminfo := array("close":Fmainform.onclose,"minimize":Fmainform.OnMinimize);
        Fmainform.onclose := thisfunction(mainformclose);
        Fmainform.OnMinimize := thisfunction(mainformminmize);
    end
    function CreateHandle();
    begin
        if not FApplicationWindow then
        begin
            FApplicationWindow := new tapplicationwindow(self);
            FApplicationWindow.Visible := FVisible;
        end
        //echo "???",tostn(FApplicationWindow.classinfo());
        FHandle := FApplicationWindow.Handle;
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        FVisible := false;
        //FTiptimer := new ttimer();
        //FTiptimer.Interval := 2000;	
        //FTiptimer.Ontimer := thisfunction(ontiptimer);	
    end
    function WMACTIVATEAPP(o,e);virtual;
    begin
        {**
        @explan(说明) active处理
        **}
        if Fmainform then
        begin
            if e.wparam then
            begin
                //_wapi.SetWindowPos(Fmainform.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE); 
                //Fmainform.Visible := true;//
                Fmainform.show();
                if Fmainform.HandleAllocated() then 
                begin
                    _wapi.SetForegroundWindow(Fmainform.handle);
                end 
            end //Fmainform.Visible := true;
            //else _wapi.SetWindowPos(Fmainform.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE);
        end
    end
    function initialize();
    begin
        {**
        @explan(说明) 初始化 %%
        **}
        CreateHandle();
        FApplicationWindow.bindmessage(WM_ACTIVATEAPP,thisfunction(WMACTIVATEAPP));
    end
    function Notification(a,op);override;
    begin        
        if op=opRecycling then 
        begin 
            if a=Fmainform  then 
            begin
                Fmainform := nil;  
            end 
            if FApplicationWindow=a then 
            begin
                FApplicationWindow := nil;    
            end 
        end 
        inherited;
    end 
    function createform(classname,varable);
    begin
        {**
        @explan(说明) 构造主窗口%%
        @param(classname)(class of TVCForm) 主窗口类 %%
        @param(varable)() tsl变量返回ClassName 构造的窗口对象 %%
        **}
        if paramcount<2 then exit; //变量不够			
        if classname is class(tcomponent)then
        begin
            //if not(FApplicationWindow)then 
            initialize();
            varable := createobject(classname,FApplicationWindow);
            if varable is class(TVCForm)then
            begin
                varable.parent := FApplicationWindow;
                if not Fmainform then
                begin
                    SetMainForm(varable);
                end
            end
        end
    end
    function mainformclose(o,e);
    begin
        {**
        @ignore(忽略) %%
        **}
        CallMessgeFunction(Foldforminfo["close"],o,e);
        if e.skip then exit;
        FApplicationWindow._send_(WM_CLOSE,0,0);
    end
    function mainformminmize(o,e);
    begin
        {**
        @ignore(忽略) %%
        **}
        CallMessgeFunction(Foldforminfo["minimize"],o,e);
        //e.skip := true;
        //if Fmainform then Fmainform.Visible := false;
        //FApplicationWindow._send_(,0,0);
    end
    function run();
    begin
        {**
        @explan(说明) 运行主循环 %%
        **}
        initialize();
        {$ifdef linuxgtk}
        idledata :=(new tcbytearray(4))._getptr_();
        id := tsl_gtk_idle_interface(idledata);//_wapi.tsl_gtk_idle_interface(idledata); //构造idle
        _wapi.gtk_main();
        _Wapi.g_idle_remove_by_data(idledata); //删除idle
        return 1;
        {$endif}
        if not FMessageObj then FMessageObj := new TTagMSG();
        ptr := FMessageObj._getptr_;
        while true do
        begin
            if(_wapi.PeekMessageA(ptr,0,0,0,0x1))then
            begin
                if FMessageObj.message=0x12 then
                begin
                    return 1;
                end else
                begin
                    _wapi.TranslateMessage(ptr);
                    _wapi.DispatchMessageA(ptr);
                end
            end else
            begin
                tslprocessmessages(false);
                RunWorkerThreadLoop();
                _wapi.WaitMessage();
            end
        end
        {while (_wapi.GetMessageA(ptr, 0, 0, 0)) do
        begin 
        _wapi.TranslateMessage(ptr);
        _wapi.DispatchMessageA(ptr);
        end}
        return 1;
    end
    function GetApplicationWindow();
    begin
        return FApplicationWindow;
    end
    function ShowErrorMessage(msg);
    begin
        {**
        @explan(说明)错误提示信息 %%
        **}
        if FDebug and ifstring(msg)then messageboxA(msg,"错误提示",1);
    end
    function CloseMainForm();
    begin
        {**
        @explan(说明) 关闭主窗口 %%
        **}
        if FApplicationWindow is class(TVCForm)then FApplicationWindow._send_(WM_CLOSE,0,0);
        else _wapi.PostQuitMessage(0);
    end
    function Close();
    begin
        CloseMainForm();
    end
    property Visible read FVisible write SetVisible;
    property handle read FHandle;
    property IfDebug read FDebug write FDebug;
    property MainForm read Fmainform write SetMainForm;
end

type TLabel = class(TcustomLabel)
    {**
    @explan(说明)标签控件 %%
    **}       
    function create(AOwner);override;
    begin
        inherited;
    end

    function publishs();override;
    begin
        return array("name","action","align","anchors","caption","enabled","font","border",
            "popupmenu","visible","textalign",
            "height","width","left","top","color","bkbitmap","parentcolor","parentfont","transparent",
            "onpopupmenu","onmousedown","onmouseup","onnotification");
    end
    {**
    @param(TextAlign)(member of TAlignStyle9) 文字对齐 %%
    **}
end 
	//窗口

type TSysControl=class(TWincontrol)
    {**
    @explan(说明) 系统绘制窗口,屏蔽绘制和背景处理,加快速度 %%
    **}
    function Create(AOwner);override;
    begin
        inherited;
    end
    function WMPAINT(o,e):WM_PAINT;override;
    begin
        if not Font.HandleAllocated()then
        begin
            FontChanged();
        end
    end
    function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
    begin
    end
end
type TWinControlWraper=class(TWinControl)
    {**
    @explan(说明) 包裹window句柄类,继承该类,根据CreateWnd 注释的提示重写该函数
    实现其他窗口库(必须含有句柄)和tslvcl库的对象兼容%%
    **}
    private
    FWindowInfo;
    protected
    function WrapHandle(h);
    begin
        {**
        @explan(说明) 包裹句柄,重写 CreateWnd中调用 %%
        **}
        oh := Handle;
        if _wapi.IsWindow(h)and h <> oh then
        begin
            if oh then
            begin
                WMNCDESTROY(self(true),new tuieventbase(0,0,0,0));
            end
            _wapi.GetWindowInfo(h,FWindowInfo._getptr_);
            rc := FWindowInfo.rcwindow;
            FLeft := rc[0];
            FTop := rc[1];
            FWidth := rc[2]-rc[0];
            FHeight := rc[3]-rc[1];
            old := _wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,getwinprocptr());
            FDefWndproc := old;
            class(tUIglobalData).uigetdata("TGlobalComponentcache").registerhandle(h,self(true));
            Handle := h;
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        FWindowInfo := new TWINDOWINFO();
    end
    function WMNCDESTROY(o,e):WM_NCDESTROY;override;
    begin
        if HandleAllocated()then
        begin
            h := Handle;
            _wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,FDefWndproc);
            class(tUIglobalData).uigetdata("TGlobalComponentcache").unregisterhandle(h);
        end
        inherited;
    end
    function CreateWnd();override;
    begin
        {**
        @explan(说明) 重写该函数构造句柄 包括三部分 
        //************获得构造参数*************************
        CreateParams(p);  //构造参数函数
        tcc := p.Caption; //标题
        stl := p.style;
        x := p.x; //下边
        y := p.y; //上边
        w := p.width;//宽度
        h := p.height; //高度
        phandle := p.WndParent; //父窗口句柄
        //***********构造句柄******************
        //****************************************
        //***********包裹句柄*************************
        WrapHandle(thandle); //包裹句柄 
        //************初始化*************************
        InitializeWnd(); //初始化 
        ControlCreateWnd();	//构造子窗口句柄			 	
        **}
    end
end

type TScrollingWinControl = class(TCustomScrollControl)
    {**
    @explan(说明) 滚动条窗口 %%
    **}
    protected
    function GetClientXCapacity();virtual; //宽度容量
    begin
        return integer(ClientRect[2]/GetXScrollDelta());
    end
    function GetClientYCapacity();virtual; //高度容量
    begin
        return integer(ClientRect[3]/GetYScrollDelta());
    end
    function GetClientXCount();virtual; //宽度间隔
    begin
        wd := 0;
        for i := 0 to Controls.Count-1 do
        begin
            c := Controls[i];
            if(c is class(TWinControl))and c.WsPopUp then continue; //处理
            br := c.Left+c.Width;
            wd := max(wd,br);
        end
        return integer(wd/GetXScrollDelta());
    end
    function GetClientYCount();virtual; //高度项
    begin
        h := 0;
        for i := 0 to Controls.Count-1 do
        begin
            c := Controls[i];
            if(c is class(TWinControl))and c.WsPopUp then continue; //处理
            br := c.Top+c.Height;
            h := max(h,br);
        end
        return integer(h/GetYScrollDelta());
    end
    function PositionChanged();virtual;
    begin
        dx := GetXScrollDelta()* GetDeltaXPos();
        dy := GetYScrollDelta()* GetDeltaYPos();
        for i := 0 to Controls.Count-1 do
        begin
            c := Controls[i];
            if(c is class(TWinControl))and c.WsPopUp then
            begin
                continue;
            end
            c.Top -= dy;
            c.Left -= dx;
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        ThumbTrack := TRUE;
    end 
    function doControlALign();override;
    begin
        if AutoScroll then InitialScroll();
        else inherited;
    end
    function DoControlAnchor();virtual;
    begin
        if AutoScroll then return;
        inherited;
    end
end

type TPanel=class(TScrollingWinControl)	//容器
    {**
    @explan(说明) 面板控件 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
    function AfterConstruction();override;
    begin
        inherited;
        caption := "panel";
        height := 300;
        width := 300;
        AutoScroll := false;
        WsDlgModalFrame := true;
        //color := _wapi.GetSysColor(COLOR_MENU);
    end 
    function CreateParams(p);override;
    begin
        inherited;
        p.WinClassName := "tui_panel";
        p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
        //p.exstyle := 0x101;
    end
    function paint();override;
    begin
        inherited;
        drawdesigninggrid();
    end 
    function publishs();override;
    begin
        return array("name","align","anchors","caption","enabled","cursor","font",
            "popupmenu","visible",
            "height","width","left","top","border",
            "zorder","color","bkbitmap","parentcolor","parentfont",
            //"minwidth","minheight",
            "wspopup","wsdlgmodalframe","wscaption","wssizebox","wssysmenu",
            "autoscroll",
            "onmousewheel","onsize","onmove","onmousemove","onpopupmenu",
            "onmousedown","onmouseup",
            "onactivate","onclose",
            "onsetfocus","onkillfocus",
            "onkeyup","onkeydown","onkeypress","onnotification"
        );
    end
end
//托盘
type TTray=class(TComponent)
    {**
    @explan(说明) 托盘类 %%
    **}
    private
    FNid;
    FTrayID;
    FIcon;
    FHaveadd;
    FPopupMenu;
    FOnclick;
    FOnMouseMove;
    static FSIDC; //id 构造器
    FCaption;
    FForm;
    function SetCaption(v);
    begin
        if v <> FCaption then
        begin
            if ifstring(v)then
            begin
                FCaption := v;
            end else
            begin
                FCaption := "";
            end
            FNid.sztip := FCaption;
            if FHaveadd then
            begin
                _wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
            end
        end
    end
    function seticonhandle(ic);
    begin
        if(ic is class(tcustomicon))and ic.HandleAllocated()and FHaveadd then
        begin
            Fnid.uFlags := NIF_ICON .| NIF_MESSAGE .| NIF_TIP .| NIF_INFO;
            Fnid.hicon := ic.Handle;
            _wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
        end
    end
    function SetIcon(v);
    begin
        if v=FIcon then exit;
        FIcon := v;
        seticonhandle(FIcon);
    end
    function SetForm(f);
    begin
        if FForm=f then exit;
        if FHaveadd then
        begin
            TrayDelete();
        end
        FForm := f;
        TrayAdd();
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        FHaveadd := false;
        if not FSIDC then FSIDC := new tidcreater(1);
        FTrayID := FSIDC.CreateId();
        FNid := new TNOTIFYICONDATAA();
        FNid.uID := FTrayID;
        FNid.ucallbackmessage := WM_TRAY;
    end
    function ShowTrayMessage(title,text);
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) 显示托盘消息 %%
        @param(title)(string)标题 %%
        @param(text)(string) 消息 %%
			
        **}
        if not FHaveadd then exit;
        if not(ifstring(title)and ifstring(text))then exit;
        if not((FForm is class(TVCForm))and FForm.HandleAllocated)then exit;
        FNid.szinfotitle := title+"\0";
        FNid.szinfo := text+"\0";
        FNid.utimeout := 1000;
        _wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
    end
    function ShowPopUpMenu();
    begin
        if not FHaveadd then exit;
        if FPopupMenu is class({TcustomPopupmenu}TcustomMenu)then
        begin
            ps := array(x,y);
            _wapi.GetCursorPos(ps);
            uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
            hd := FForm.Handle;
            _wapi.SetForegroundWindow(hd);
            _wapi.TrackPopupMenu(FPopupMenu.Handle,uf,ps[0],ps[1],0,hd,nil);
            return true;
        end
    end
    function Notification(AComponent:TComponent;Operation:TOperation);override;
    begin
        {**
        @explan(说明) 通知消息处理 %%
        **}
        if Operation=opRecycling then //opRemove
        begin
            if FPopupMenu=AComponent then
            begin
                FPopupMenu := nil;
            end
            if FForm=AComponent then
            begin
                Form := nil;
            end
        end;
        inherited;
    end;
    function Recycling();override;
    begin
        FIcon := nil;
        TrayDelete();
        FForm := nil;
        FPopupMenu := nil;
        inherited;
    end
    //添加到托盘栏
    function TrayAdd();
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) 添加 %%
        **}
        if FHaveadd then exit;
        if(FForm is class(TVCForm))and FForm.HandleAllocated()then
        begin
            FNid.hWnd := FForm.Handle;
            if not FIcon then FIcon := FForm.FormIcon;
            if FIcon is class(tcustomicon)then
            begin
                FNid.hIcon := FIcon.Handle;
            end
            if ifstring(FCaption)then FNid.sztip := FCaption;
            else FNid.sztip := FForm.Caption;
            //FNid.dwInfoFlags := 1;
            Fnid.uFlags := NIF_ICON .| NIF_MESSAGE .| NIF_TIP .| NIF_INFO;
            _wapi.Shell_NotifyIconA(NIM_ADD,FNid._getptr_);
            FHaveadd := true;
        end
    end
    //从托盘栏删除 
    function TrayDelete();
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) 删除 %%
        **}
        if FHaveadd then
        begin
            _wapi.Shell_NotifyIconA(nim_delete,FNid._getptr_);
            FHaveadd := false;
        end
    end
    function publishs();override;
    begin
        return array("name","caption","icon","popupmenu","onclick","onnotification");
    end
    property Form read FForm write SetForm;
    property Caption:string read FCaption write SetCaption;
    property OnClick:eventhandler read FOnclick write FOnclick;
    property OnMouseMove:eventhandler read FOnMouseMove write FOnMouseMove;
    property Icon:ticon read FIcon write SetIcon;
    property PopupMenu:TPopUpmenu read FPopupMenu write FPopupMenu;
    property TrayId read FTrayID;
end
type TVCForm = class(TScrollingWinControl)
    {**
    @explan(说明)主窗口类 %%
    **}
    private
    FOnMinimize;
    FMainMenu;
    FTray;
    FFormBorderStyle;
    FMaxminbox;
    FFormIcon;
    function traypopmenu();
    begin
        if(FTray is class(TTray))then
        begin
            tp := FTray.PopupMenu;
            if tp is class({TcustomPopupmenu}TcustomMenu)then
            begin
                return tp;
            end
        end
    end
    function SetTray(t);
    begin
        if FTray=t then exit;
        FTray := t;
        if csDesigning in ComponentState then
        begin
            return;
        end
        if FTray is class(TTray)then
        begin
            FTray.Form := self(true);
        end
    end
    function seticonhandle();
    begin
        if HandleAllocated()and(FFormIcon is class(tcustomicon))and FFormIcon.HandleAllocated()then
        begin
            _send_(WM_SETICON,1,FFormIcon.handle,1);
        end else
        _send_(WM_SETICON,1,0,1);
    end
    function SetFormIcon(v);
    begin
        if v=FFormIcon then exit;
        FFormIcon := v;
        return seticonhandle();
        if csDesigning in ComponentState then
        begin
            FFormIcon := v;
            return;
        end
        if v is class(tcustombitmap)then
        begin
            if v.HandleAllocated()then
            begin
                vn := v.tovcon();
            end
        end
        if ifarray(v)or ifarray(vn)then
        begin
            if not(FFormIcon is class(tcustomicon))then FFormIcon := new tcustomicon();
            FFormIcon.readvcon(v?v:vn);
            seticonhandle();
        end //else 
    end
    function GetFormIcon();
    begin
        return FFormIcon;
    end
    function SetMaxMinBox(v);
    begin
        nv := v?true:false;
        if nv <> FMaxminbox then
        begin
            FMaxminbox := nv;
            if HandleAllocated()then
            begin
                if nv then appendwstyle(WS_MAXIMIZEBOX .| WS_MINIMIZEBOX);
                else minuswstyle(WS_MAXIMIZEBOX .| WS_MINIMIZEBOX);
            end
        end
    end
    function SetFormBorderStyle(NewStyle);
    begin
        //if FFormBorderStyle = NewStyle then exit;  
    end
    function SetMainMenu(mu);
    begin
        if FMainMenu <> mu then
        begin
            OM := FMainMenu;
            if OM is class(TcustomMainmenu)then 
            begin
                OM.DestroyHandle(); //删除句柄 %%
                OM.Hwnd := 0;
                //if HandleAllocated() then _wapi.SetMenu(self.Handle,0);	//删除窗口上面的菜单句柄  
            end
            if(mu is class(TcustomMainmenu))then
            begin
                if HandleAllocated()then
                begin
                    mu.Hwnd := handle;
                    //_wapi.SetMenu(self.Handle,mu.handle);
                end
            end
            FMainMenu := mu;
        end
    end
    function GetWsSysMenu();override;
    begin
        return true;
    end
    function SetWsSysMenu(v);override;
    begin
    end
    function SetBorder(v);override;
    begin
    end
    function SetWsPopUp(v);override;
    begin
    end
    function GetWsPopUp();override;
    begin
        return true;
    end
    {
    function GetWsCaption(v);override;
    begin
    	return true;
    end 
    function SetWsCaption(v);override;
    begin
    
    end }
    public 
    class function MenuBarHeight();
    begin
        {**
        @explan(说明) 获得菜单栏的高度 %%
        @return(integer) 高度 %%
        **}
        return _wapi.GetSystemMetrics(SM_CYMENU);
    end
    function create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        FFormBorderStyle := bsNone;
        caption := "tform";
        rc := _wapi.GetScreenRect();
        wd :=(rc[2]-rc[0])/2;
        h :=(rc[3]-rc[1])/2;
        FLeft := rc[0]+wd/2;
        FTop := rc[1]+h/2;
        FHeight := h;
        FWidth := wd;
        Color := 0x00FFFFFF;
        cursor := IDC_ARROW; //OCR_NORMAL;
        WsPopUp := true;
        FMaxminbox := true;
        WsCaption := true;
        WSSizebox := true;
    end
    function WMTIMER(o,e):WM_TIMER;virtual;
    begin
        //echo "\r\ntimer";
    end
    function WMTRAY(o,e):WM_TRAY;virtual;
    begin
        if not(FTray is class(TTray))then exit;
        case e.lParam of
            WM_RBUTTONUP:
            begin
                //左键
                FTray.ShowPopUpMenu();
            end
            WM_LBUTTONUP:
            begin
                if Visible and HandleAllocated()then _wapi.SetForegroundWindow(self.Handle);
                CallMessgeFunction(FTray.OnClick,FTray,e);
            end
            WM_MOUSEMOVE:
            begin
                CallMessgeFunction(FTray.OnMouseMove,FTray,e);
            end
        end;
    end
    function Paint();override;
    begin
        inherited;
        drawdesigninggrid();
    end 
    function WMSYSCOMMAND(o,e):WM_SYSCOMMAND;override;
    begin
        {**
        @explan(说明)系统菜单消息处理 %%
        **}
        if e.wparam=SC_MINIMIZE then
        begin
            CallMessgeFunction(OnMinimize,o,e);
        end else
        begin
            inherited;
        end
    end
    function WMCOMMAND(o,e):WM_COMMAND;override;
    begin
        {**
        @explan(说明) command 消息处理
        **}
        if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
        trp := traypopmenu();
        if trp and trp.dispatch(e)then exit;
        inherited;
    end
    function wmcreate(o,e):WM_CREATE;override;
    begin
        inherited;
        //echo "\r\ncreate:",o.caption;
    end
    function WMMEASUREITEM(o,e):WM_MEASUREITEM;override;
    begin
        if e.wparam=0 and(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
        trp := traypopmenu();
        if trp and trp.dispatch(e)then exit;
        inherited;
    end
    function WMMENURBUTTONUP(o,e):WM_MENURBUTTONUP;override;
    begin
        if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
        trp := traypopmenu();
        if trp and trp.dispatch(e)then exit;
        inherited;
    end
    function WMMENUSELECT(o,e):WM_MENUSELECT;override;
    begin
        if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
        trp := traypopmenu();
        if trp and trp.dispatch(e)then exit;
        inherited;
    end
    function WMINITMENUPOPUP(o,e):WM_INITMENUPOPUP;override;
    begin
        if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
        trp := traypopmenu();
        if trp and trp.dispatch(e)then exit;
        inherited;
    end
    function WMDRAWITEM(o,e):WM_DRAWITEM;override;
    begin
        if e.wparam=0 and(FMainMenu is class(TcustomMainmenu))then
        begin
            e.canvas := canvas;
            canvas.handle := e.hdc;
            r := FMainMenu.Dispatch(e);
            e.canvas := nil;
            if r then exit;
        end
        trp := traypopmenu();
        if e.wparam=0 and trp then
        begin
            e.canvas := canvas;
            canvas.handle := e.hdc;
            r := trp.Dispatch(e);
            e.canvas := nil;
            if r then exit;
        end
        inherited;
    end
    function createparams(p);override;
    begin
        inherited;
        p.WinClassName := "tsui_form"; //"tsui_form";	
        //p.style :=( p.style .| WS_TILEDWINDOW );// .& (.! ( WS_CHILD));//WS_GROUP .| WS_TABSTOP .|
        p.style .|= WS_OVERLAPPED .| WS_SYSMENU .| WS_POPUP .| WS_MINIMIZEBOX .| WS_MAXIMIZEBOX;
        p.style := bitcombination(p.style,WS_CHILD .| WS_GROUP .| WS_TABSTOP,2);
        //P.style .|= WS_CLIPSIBLINGS;
        if minmaxbox then
        begin
            p.style .|= WS_MAXIMIZEBOX .| WS_MINIMIZEBOX;
        end else
        begin
            p.style := bitcombination(p.style,WS_MAXIMIZEBOX .| WS_MINIMIZEBOX,2);
        end
        P.ExStyle := P.ExStyle .| WS_EX_APPWINDOW;
        //p.style :=0xcf0000 .| 0x0008 .| 0x02000000L .|0x04000000L ;//.| WS_VSCROLL .| WS_HSCROLL;// WS_VISIBLE .|  WS_POPUP .| WS_CAPTION .| WS_CLIPSIBLINGS .| WS_SYSMENU .| WS_MINIMIZE .| WS_MAXIMIZEBOX;
        p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
    end
    procedure FontChanged(Sender:TObject);override;
    begin
        if(HandleAllocated())then
        begin
            _send_(WM_SETFONT,Font.Handle,1);
        end else
        inherited;
    end
    function DestroyHandle();override;
    begin
        if FMainMenu is class(TcustomMainmenu)then
        begin
            FMainMenu.DestroyHandle();
        end
        if FTray is class(TTray)then
        begin
            FTray.TrayDelete();
        end
        inherited;
    end
    function InitializeWnd();override;
    begin
        if HandleAllocated()then
        begin
            if FMainMenu is class(TcustomMainmenu)then
            begin
                FMainMenu.Hwnd := handle;
            end
            seticonhandle();
            if FTray is class(TTray)then
            begin
                FTray.TrayAdd();
            end
        end
    end
    function Notification(AComponent:TComponent;Operation:TOperation);override;
    begin
        {**
        @explan(说明) 通知消息处理 %%
        **}
        if Operation=opRecycling then //opRemove
        begin
            if AComponent=FMainMenu then FMainMenu := nil;
            if FTray=AComponent then
            begin
                FTray := nil;
            end
        end;
        inherited;
    end;
    property OnMinimize:eventhandler read FOnMinimize write FOnMinimize;
    property MainMenu:tmainmenu read FMainMenu write SetMainMenu;
    property minmaxbox:bool read FMaxminbox write SetMaxMinBox;
    {**
    @param(MainMenu)(tmainmenu) 主菜单 %%
    @param(OnMinimize)(function[self,tuieventbase]) 主菜单 %%
    **}
    property BorderStyle:TFormBorderStyle read FFormBorderStyle write SetFormBorderStyle;
    property FormIcon:ticon read GetFormIcon write SetFormIcon;
    property Tray:ttray READ FTray write SetTray;
    function publishs();override;
    begin
        return array(
            "name","action","caption","cursor","font",
            "popupmenu","visible",
            "height","width","left","top",
            "color","bkbitmap","parentcolor","parentfont",
            //"minwidth","minheight",
            "wssizebox","wsdlgmodalframe",
            "mainmenu","minmaxbox","formicon","tray",
            "onsize","onmove","onmousemove",
            "onmousedown","onmouseup",
            "onactivate","onclose",
            "onsetfocus","onkillfocus","onpopupmenu",
            "onkeyup","onkeydown","onkeypress","onnotification"
        );
    end

end 
type tform=class(TVCForm)
    {**
    @explan(说明) 可能和web全局重名不建议使用 %%
    **}
    function Create(AOwner);override;
    begin
        inherited;
    end
end
type TpanelForm=class(tpanel) //设计器的面板窗口
    {**
    @explan(说明) 面板窗口 ,在设计器中使用 %%
    **}
    protected
    function SetWsPopUp(v);override;
    begin
        if csDesigning in ComponentState then
        begin
        end else
        begin
            inherited;
        end
    end
    function GetWsPopUp();override;
    begin
        if csDesigning in ComponentState then
        begin
            return true;
        end else
        begin
            return inherited;
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        rc := _wapi.GetScreenRect();
        wd :=(rc[2]-rc[0])/3;
        h :=(rc[3]-rc[1])/3;
        FLeft := rc[0]+wd/2;
        FTop := rc[1]+h/2;
        FHeight := h;
        FWidth := wd;
        wspopup := true;
    end 
    function Paint();override;
    begin
        inherited;
        drawdesigninggrid();
    end 
    function SetDesigning(f,fc);override;
    begin
        if f then wspopup := true;
        inherited;
    end
end
type TDCreateForm=class(TVCForm) //设计器的窗口
    function Create(AOwner);override;
    begin
        inherited;
    end
    function AfterConstruction();override;
    begin
        inherited;
        Loader.LoadFromTfm(self(true));
    end 
    function publishs();override;
    begin
        r := inherited;
        r[length(r)] := "oncreated";
        r[length(r)] := "ondestroy";
        return r;
    end 

end
type TDCreatePanel=class(TpanelForm) //设计器的面板
    function Create(AOwner);override;
    begin
        inherited;
    end
    function AfterConstruction();override;
    begin
        inherited;
        Loader.LoadFromTfm(self(true));
    end 
    function publishs();override;
    begin
        r := inherited;
        r[length(r)] := "oncreated";
        r[length(r)] := "ondestroy";
        return r;
    end 

end

	//按钮
type tbtn = class(tcustombtn) //按钮
{**
		        @explan(说明) 普通按钮 %%
	**}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return  array("name","action","left","top","width","height",
            "align","anchors","caption","font","enabled","visible","bkbitmap","color","parentcolor","parentfont","tabstop",
            "onclick","onmousemove","onsetfocus","onkillfocus","onkeyup","onkeydown","onkeypress","onnotification");
    end 

end 
type tcheckbtn = class(tcustomcheckbtn) //复选框
    {**
    @explan(说明) 复选框 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "caption","anchors","enabled","color","visible","font","parentcolor","parentfont",
            "textpos","checked","lefttext","tabstop","onclick","onmousemove","onmousedown","onmouseup","onnotification");
    end 

end 
type tradiobtn = class(tcustomradiobtn) //单选框
    {**
    @explan(说明)radiobtn单选按钮控件
    **}
    function create(AOwner);
    begin
        inherited;  
    end
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "caption","anchors","enabled","color","visible","font","parentcolor","parentfont",
            "textpos","checked","lefttext","tabstop","onclick","onmousemove","onmousedown","onmouseup","onnotification");
    end 
    
end 

type TPopMenuBtn=class(TBtn)
    {**
    @ignore(忽略) %%
    @explan(说明) 弹出菜单的按钮 %%
    **}
    private
    FInfo;
    public
    function Create(AOwner);override;
    begin
        inherited;
        caption := "menubtn";
    end
    function SetInfo(info);
    begin
        if FInfo=info then exit;
        mu := nil;
        if ifarray(info)then
        begin
            mu := new TPopUpMenu(self);
            mu.caption := info["caption"];
            CreateMenu(mu,info["menus"]);
            FInfo := info;
        end
        PopUpMenu := mu;
    end
    function BMCLICK(o,e):BM_CLICK;override;
    begin
        DoClick(o,e);
    end
    property PopupMenu:tpopupmenu read GetPopUpMenu write SetPopUpMenu;
    private
    function SetPopUpMenu(p);
    begin
        if p is class(TPopUpmenu)then
        begin
            caption := p.caption;
        end
        class(TBtn).PopupMenu := p;
    end
    function GetPopUpMenu();
    begin
        return class(TBtn).PoPupMenu;
    end
    function ContextMenu(o,e);override;
    begin
        e.skip := true;
    end
    function DoClick(o,e);
    begin
        xy := array(0,height+1);
        xy := clienttoscreen(xy[0],xy[1]);
        if PopupMenu is class(TPopUpmenu)then
        begin
            uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
            _wapi.TrackPopupMenu(PopupMenu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
        end
    end
    function CreateMenu(o,info);
    begin
        for i,v in info do
        begin
            if ifarray(v)then
            begin
                mi := new TMenu(o);
                mi.caption := v["caption"];
                mi.onclick := v["onclick"];
                mi.Bitmap := v["bitmap"];
                mi.parent := o;
                CreateMenu(mi,v["menus"]);
            end
        end
    end
end

	//edit
type tedit = class(tcustomedit) //编辑框
    {**
    @explan(说明) 单行文本编辑框类 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","align","anchors","border","font","color","enabled","parentcolor","parentfont","popupmenu","visible","height","width","left","top","text","placeholder"
            ,"readonly","limitlength","linewrap","tabstop","onmousemove","onpopupmenu","onmousedown","onmouseup","onkeyup"
            ,"onkeydown","onkeypress","onmaxtext","onkillfocus","onsetfocus","onchange","onnotification");
    end
end 
type tpassword = class(tcustompassword) //密码框
		{**
				@explan(说明) 密码编辑框类 %%
		**}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name",
            "align","anchors","font","color","parentcolor","parentfont",
            "popupmenu","visible",
            "height","width","left","top",
            "text","placeholder","readonly","limitlength","tabstop",
            "passwordchar","onmousemove","onpopupmenu",
            "onmousedown","onmouseup",
            "onkeyup","onkeydown","onkeypress",
            "onmaxtext","onkillfocus","onsetfocus","onchange","onnotification");
    end
end 

type tmemo = class(TSynMemoNorm)   //多行文本框
    uses UTslMemo; 
    {**
        @explan(说明) 多行文本控件 %%
    **} 
    function create(aowner);
    begin
        inherited;
        Left := 10;
        Top := 10;
        Width := 150;
        Height := 90;
        GutterCharCnt := 0;
        Border := true;
    end 
    function DoTextChanged(p);override;//文本改变
    begin	
        inherited;
        if Fonchange then 
            calldatafunction(Fonchange,self(true),new tuieventbase(0,0,0,0));
    end 
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        inherited;
    end 
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        inherited;
    end 
    function getlinecount();
    begin
        return Lines.length();
    end 
    function getline(i);
    begin
        ls := lines;
        r :=  ls.GetStringByIndex(i-1);
        if ifstring(r) then return r;
        return "";
    end 
    function Recycling();override;
    begin
        inherited;
        Fonchange := nil;    
        FTabspace := nil; 
        FLineWrap := nil;   
        FonSetFocus := nil;
        FonKillFocus := nil;
    end 
    public 
    property onupdate read Fonchange write Fonchange;
    property onchange read Fonchange write Fonchange;
    property LineWrap read FLineWrap write FLineWrap;
    property tabspace read FTabspace write FTabspace;
     {**
    			@param(LineWrap)(bool)自动换行,默认为false不自动换行%%				
    			@param(onupdate)(fpointer)文本更新回调%%
    			@param(onchange)(fpointer)文本改变回调%%
		 **}
    function publishs();override;
    begin
    	    return array("name","font","color","parentcolor","parentfont",
    		"popupmenu","visible","anchors","align",
    		"height","width","left","top",
    		"text","readonly","selectbkcolor","guttercolor","currentlinecolor","guttercharcnt","autogutterwidth",
    		"tabspace","highlighter","onmousewheel","onmousemove","onpopupmenu",
    		"onmousedown","onmouseup","onsetfocus","onkillfocus",
    		"onkeyup","onkeydown","onkeypress",
    		"onchange","onnotification");
    end 
    private 
    Fonchange;
    FLineWrap;
    FTabspace;
    FonSetFocus;
    fonKillFocus;
end 
type thighlighter= class(tcustomsynhighlighter)
    uses UTslMemo;
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","keywordcolor","symcolor","stringcolor","annotationcolor","ignorecase","onnotification");
    end 
end 

	//goupbox
type tgroupbox = class(tcustomgroupbox)
    	{**
    		@explan(说明) groupbox %%
    	**}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "align","anchors","border","caption","color","enabled","font","visible","textpos","parentcolor","parentfont","wsdlgmodalframe",
            "onsize","onnotification");
    end 
end  

type TCheckGroupBox=class(TRadioGroupBox)
    {**
    @explan(说明) checkgroupbox %%
    @ignore(忽略) %%
    **}
    private
    FItemIndexs;
    function GetSelected();virtual;
    begin
        return GetItemByIndex(FItemIndexs);
    end
    function SetItemIndex();override;
    begin
    end
    function GetItemIndexs();
    begin
        r := array();
        k := 0;
        for i,v in FItemIndexs do
        begin
            if ifstring(GetItemByIndex(v))then
            begin
                r[k++]:= v;
            end
        end
        return r;
    end
    function SetItemIndexs(v);
    begin
        if v=FItemIndexs then exit;
        FItemIndexs := array();
        for i,vi in v do if vi >=-1 then FItemIndexs[k++]:= vi;
        if Items then
        begin
            ReDrawItems();
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        caption := "check groupbox";
        FItemIndexs := array();
    end
    function Drawbox(dc,src,idx);override;
    begin
        //_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,(idx in FItemIndexs)?DFCS_CHECKED:DFCS_BUTTONCHECK);
        dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,(idx in FItemIndexs)?DFCS_CHECKED:DFCS_BUTTONCHECK);
    end
    function GridClick(o,e);override;
    begin
        i := e.iitem;
        j := e.isubitem;
        idx := rctoindex(i,j);
        it := GetItemByIndex(idx);
        if not(i >= 0 and j >= 0)then exit;
        if not ifstring(it)then exit;
        if idx in FItemIndexs then
        begin
            FItemIndexs minus= array(idx);
        end else
        begin
            FItemIndexs union=array(idx);
        end
        InvalidateSubItem(idx,true);
        CallMessgeFunction(OnSelectionChanged,self,e);
    end
    property ItemIndexs:integers read GetItemIndexs write SetItemIndexs;
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "align","border","ItemIndexs","caption","color","enabled","font",
            //"minheight","minwidth",
            "parentfont","parentfont","visible","textpos","wsdlgmodalframe","onnotification");
    end
end

type TRadioGroupBox=class(TGroupbox)
    {**
    @explan(说明) radiogroupbox %%
    @ignore(忽略) %%
    **}
    private
    FGrid;
    FItemIndex;
    FColumns;
    FRows;
    FItems;
    FSelectionChanged;
    FColumnLayout;
    function SetColumnLayout(v);
    begin
        if FColumnLayout <> V and(v in array(pstHorizontal,pstVertical))then
        begin
            FColumnLayout := v;
            if FColumns>1 and FItems then
            begin
                ReDrawItems();
            end
        end
    end
    Function SetColumns(n);
    begin
        if n>0 and n <> FColumns then
        begin
            FColumns := n;
            fcs := array();
            for i := 1 to n do fcs[i-1]:= array("text":" ","width":100);
            FGrid.Columns := fcs;
            FRows := ceil(length(FItems)/FColumns);
            FGrid.ItemCount := FRows;
            GRIDsize(FGrid);
        end
    end
    function SetItemIndex(idx);virtual;
    begin
        if idx>-2 and idx <> FItemIndex then
        begin
            FItemIndex := idx;
            FGrid.InvalidateRect(nil,true);
        end
    end
    function SetItems(v);
    begin
        its := array();
        k := 0;
        for i,vi in v do
        begin
            if ifstring(vi)then
            begin
                its[k++]:= vi;
            end
        end
        if FItems=its then exit;
        FItems := its;
        FRows := ceil(length(its)/FColumns);
        FGrid.ItemCount := FRows;
        GRIDsize(FGrid);
    end
    protected
    function GetControlFont();override;
    begin
        return FGrid.Font;
    end
    function SetControlFont(v);override;
    begin
        if FGrid then
        begin
            FGrid.font := v;
        end
    end
    function rctoindex(i,j);
    begin
        if FColumnLayout=pstHorizontal then return i * Columns+j;
        return idx := j * FRows+i;
    end
    function indextorc(idx,i,j);
    begin
        case FColumnLayout of
            pstHorizontal:
            begin
                j := idx mod FColumns;
                i := idx div FColumns;
            end
            pstVertical:
            begin
                i := idx mod FRows;
                j := idx div FRows;
            end
        end;
    end
    function ReDrawItems();
    begin
        if FGrid and FGrid.HandleAllocated()and FItems then FGrid.InvalidateRect(nil,true);
    end
    function GetSelected();virtual;
    begin
        return GetItemByIndex(array(FItemIndex));
    end
    public
    function SetItemByIndex(idx,v);
    begin
        if not ifstring(v)then exit;
        s := GetItemByIndex(idx);
        if ifstring(s)then FItems[idx]:= v;
        return 1;
    end
    function GetItemByIndex(idx);
    begin
        if ifarray(idx)then
        begin
            r := array();
            k := 0;
            for i,v in idx do
            begin
                vi := call(thisfunction,v);
                if ifstring(vi)then r[v]:= vi;
            end
            return r;
        end else
        if ifnumber(idx)then return FItems[idx];
    end
    function SetDesigning(f,fc);override;
    begin
        {**
        @explan(说明) 设计器使用方法,设置为设计状态,或者解除设置状态 %%
        @param(f)(bool) 状态值 %%
        @param(fc)(bool) 是否修改子控件状态 %%
        **}
        inherited;
        if not FGrid then exit;
        if f then
        begin
            FGrid.Enabled := false;
        end else
        FGrid.Enabled := true;
    end
    function create(AOwner);override;
    begin
        inherited;
        caption := "radio groupbox";
        color := _wapi.GetSysColor(COLOR_WINDOW);
        FRows := 0;
        FColumnLayout := pstHorizontal;
        border := true;
        FGrid := new TDrawGrid(self);
        FGrid.border := false;
        FGrid.ColumnHeader := false;
        FGrid.GridLine := false;
        FGrid.MouseSizeCell := 0;
        FItems := array();
        FItemIndex :=-1;
        FGrid.Onclick := thisfunction(GridClick);
        FGrid.parent := self;
        FGrid.onsize := thisfunction(GRIDsize);
        FGrid.OnDoDrawSubItem := thisfunction(DrawGrid);
        SetColumns(1);
    end
    function DoControlAlign();override;
    begin
        cr := ClientRect;
        cr[1]+= 20;
        cr[0]+= 2;
        cr[2]-= 2;
        cr[3]-= 2;
        if FGrid then FGrid.SetBoundsRect(cr);
    end
    function InitializeWnd();override;
    begin
        if csDesigning in ComponentState then
        begin
            FGrid.enabled := false;
        end
    end
    function GRIDsize(o,e);
    begin
        if length(FItems)<1 then exit;
        wd := floor((o.width-4)/(FColumns));
        if wd<22 then exit;
        for i := 0 to FColumns-1 do
        begin
            o.SetColumnWidth(i,wd);
        end
    end
    function Drawbox(dc,src,idx);virtual;
    begin
        //_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,(idx=FItemIndex)?DFCS_BUTTONRADIOIMAGE:DFCS_BUTTONRADIO);
        dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,(idx=FItemIndex)?DFCS_BUTTONRADIOIMAGE:DFCS_BUTTONRADIO);
    end
    function DrawGrid(o,e);
    begin
        i := e.itemid;
        j := e.subitemid;
        idx := rctoindex(i,j);
        it := FItems[idx];
        if not ifstring(it)then exit;
        rc := e.SubItemRect;
        dc := e.canvas;
        //src := array(rc[0]+1,rc[1]+1,rc[0]+18,rc[1]+18);
        tp :=(rc[3]-rc[1])/2+rc[1]-7;
        src := array(rc[0]+1,tp,rc[0]+15,tp+14);
        Drawbox(dc,src,idx);
        src := array(rc[0]+19,rc[1]+1,rc[2],rc[3]);
        dc.font := o.font;
        class(TLabel).CanvasDrawAlignText(dc,src,it,AL9_CENTERLEFT);
        e.skip := true;
    end
    function InvalidateSubItem(idx,f);
    begin
        indextorc(idx,i,j);
        rec := FGrid.GetSubItemRect(i,j);
        FGrid.invalidaterect(rec,f);
    end
    function GridClick(o,e);virtual;
    begin
        i := e.iitem;
        j := e.isubitem;
        idx := rctoindex(i,j);
        it := FItems[idx];
        if not(i >= 0 and j >= 0)then exit;
        if not ifstring(it)then exit;
        odx := FItemIndex;
        if FItemIndex=idx then
        begin
            exit;
        end else
        FItemIndex := idx;
        if odx >= 0 then
        begin
            InvalidateSubItem(odx,false);
        end
        if FItemIndex >= 0 then
        begin
            InvalidateSubItem(FItemIndex,true);
        end
        CallMessgeFunction(OnSelectionChanged,self,e);
    end
    function SetItemText(i,c);
    begin
        {**
        @explan(说明) 修改文字 %%
        @param(i)(integer) 序号 %%
        @param(c)(string) 文本 %%
        **}
        vi := FItems[i];
        if ifstring(c)and vi <> c then
        begin
            FItems[i]:= c;
            InvalidateSubItem(i,true);
        end
    end
    function DeleteItem(i);
    begin
        vi := FItems[i];
        if ifstring(vi)then
        begin
            nits := FItems;
            reindex(nits,array(i:nil));
            Items := nits;
        end
    end
    property OnSelectionChanged:eventhandler read FSelectionChanged write FSelectionChanged;
    property Columns:integer read FColumns write SetColumns;
    property ItemIndex:integer read FItemIndex write SetItemIndex;
    property Items:strings read FItems write SetItems;
    property Selected read GetSelected;
    property ColumnLayout:SplitterType read FColumnLayout write SetColumnLayout;
    function publishs();override;
    begin
        r := array("name","left","top","width","height",
            "align","border","ItemIndexs","caption","color","enabled","font",
            //"minheight","minwidth",
            "parentfont","parentcolor","visible","textpos","wsdlgmodalframe","onselectionchanged","onnotification");
        return r;
    end
    {**
    @param(OnSelectionChanged)(function[TRadioGroupBox,tuieventbase]) 选择改变时回调 %%
    @param(Columns)(integer) 列数 %%
    @param(ItemIndex)(integer) 选中项目%%
    @param(Items)(array of string) 项目标签%%
			
    **}
end
	//listbox

type TListBox = class(TcustomListBox)
    {**
    @explan(说明) listbox控件 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","caption","anchors","align","enabled",
            "font","visible","border","color",
            "height","width","left","top",
            "itemheight","items","itemindex","selbkcolor",
            "multisel","checkbox","ownerdraw","itemcount","popupmenu","wsdlgmodalframe",
            "onpopupmenu","onmousedown","onmouseup","ondrawlist",
            "onselchanged","onnotification"
        );
    end

end 
type TColorbox=class(TcustomListBox)
    {**
    @explan(说明) color box 控件 %%
    **}
    public
    function create(aOwner);override;
    begin
        inherited;
        arr := array(
            ("value":"Black","color":0),
            ("value":"Maroon","color":128),
            ("value":"Green","color":32768),
            ("value":"Olive","color":32896),
            ("value":"Navy","color":8388608),
            ("value":"Purple","color":8388736),
            ("value":"Teal","color":8421376),
            ("value":"Gray","color":8421504),
            ("value":"Silver","color":12632256),
            ("value":"Red","color":255),
            ("value":"Lime","color":65280),
            ("value":"Yellow","color":65535),
            ("value":"Blue","color":16711680),
            ("value":"Fuchsia","color":16711935),
            ("value":"Aqua","color":16776960),
            ("value":"LtGray","color":12632256),
            ("value":"DkGray","color":8421504),
            ("value":"White","color":16777215),
            ("value":"MoneyGreen","color":12639424),
            ("value":"SkyBlue","color":15780518),
            ("value":"Cream","color":15793151),
            ("value":"MedGray","color":10789024));
        setData(arr);
    end
    function getColor(n);
    begin
        {**
        @explan(说明)获取指定下标颜色的值%%
        @param(n)(integer)指定下标%%
        @return(tcolor)颜色值%%
        **}
        r := FitemData[n];
        if ifarray(r)then r := r["color"];
        if ifnumber(r)then return r;
        return nil;
    end
    function getColorName(n);
    begin
        {**
        @explan(说明)获取指定下标颜色的名字%%
        @param(n)(integer)指定下标%%
        @return(string)颜色值%%
        **}
        r := FitemData[n];
        if ifarray(r)then r := r["value"];
        if ifstring(r)then return r;
        return "";
    end
    function addColor(name,clr);
    begin
        //应输入使用rgb()函数处理的颜色值
        {**
        @explan(说明)在列表框尾部增加指定的颜色%%
        @param(name)(string)指定颜色名%%
        @param(clr)(tcolor)指定颜色值%%
        **}
        if ifnumber(clr)and ifstring(name)then appendItem(array("value":name,"color":clr));
    end
    function AppendColors(d);
    begin
        {**
        @expaln(说明) 追加多个 颜色值 %%
        @param(d)(array) 包括"value" 和 "color" 两个字段 %%
        **}
        appendItems(d);
    end
    function CheckListItem(v);override;
    begin
        return ifarray(v)and ifstring(v["value"])and ifnumber(v["color"]);
    end
    function PaintIdexText(idx,rc,cvs);override;
    begin
        rl := integer((rc[3]-rc[1])* 0.15);
        rrect := array(rc[0]+rl,rc[1]+rl,rc[0]-rl+rc[3]-rc[1],rc[3]-rl);
        cvs.brush.color := getColor(idx);
        cvs.fillrect(rrect);
        rc[0]+= rc[3]-rc[1];
        cvs.drawtext(getColorName(idx),rc,DT_NOPREFIX);
    end
    function publishs();override;
    begin
        return array("name","align","anchors","font","color",
            "visible","border","enabled",
            "height","width","left","top",
            "wsdlgmodalframe","popupmenu","parentcolor","parentfont",
            "onpopupmenu","onmousedown","onmouseup",
            "onselchanged","onnotification"
        );
    end
    private
    multiSel;
end

	//combobox

type TColorCombobox=class(TCustomComboBoxbase)
    {**
    @explan(说明) Tcolorcombobox 是一种颜色选择的combobox%%
    **}
    function Create(AOwner);override;
    begin
        inherited;
        FListBox.visible := false;
        FListBox.WsPopUp := true;
        FListBox.onselchanged := function(o,e)
        begin
            if o.visible then
            begin
                ShowDropDown(false);
                InvalidateRect(nil,false);
                CallDataFunction(OnSelchanged,self(true),e);
            end
        end
        FListBox.Parent := self;
        itemindex := 0;
    end
    function CreateAlist();override;
    begin
        r := new tcolorbox(self);
        return r;
    end
    function Paint();override;
    begin
        inherited;
        idx := ItemIndex;
        if not(idx >= 0)then return;
        dc := canvas;
        rc := ClientRect;
        rc[2]-= BtnWidth;
        FListBox.PaintIdx(idx,rc,dc);
        return;
        cl := getColorValue(idx);
        txt := getColorName(idx);
        dc.brush.Color := cl;
        rc[2]-= BtnWidth;
        rc2 := rc;
        rc2[2]:= 20;
        rc[0]+= 22;
        bd := 2;
        rc2[0]+= bd;
        rc2[1]+= bd;
        rc2[2]-= bd;
        rc2[3]-= bd;
        dc.Draw("rectangle",array(rc2[0:1],rc2[2:3]));
        dc.DrawText(txt,rc,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
    end
    function addColor(name,clr);
    begin
        {**
        @explan(说明)添加颜色%%
        @param(colorName)(string)颜色名称例如"Red"%
        @param(colorValue)(integer)颜色值%%
        **}
        FListBox.addColor(name,clr);
    end
    function AppendColors(d);
    begin
        {**
        @expaln(说明) 追加多个 颜色值 %%
        @param(d)(array) 包括"value" 和 "color" 两个字段 %%
        **}
        return FListBox.AppendColors(d);
    end
    function Clean();
    begin
        {**
        @explan(说明)清空颜色值 %%
        **}
        FListBox.Clean();
    end
    function getcurrentColor();
    begin
        {**
        @explan(说明)获得被选中的颜色名称%%
        @return(integer) 颜色 %%
        **}
        idx := ItemIndex;
        return getColorValue(idx);
    end
    function getColorName(id)
    begin
        {**
        @explan(说明)获取颜色%%
        @param(id)(integer)序号id%%
        @return(string)返回颜色名称%%
        **}
        return FListBox.getColorName(id);
    end
    function getColorValue(id)
    begin
        {**
        @explan(说明)获取颜色值%%
        @param(id)(integer)序号id%%
        @return(integer)返回颜色值%%
        **}
        return FListBox.getColor(id);
    end
    function publishs();override;
    begin
        return array("name","anchors","font","color",
            "visible","parentcolor","parentfont",
            "height","width","left","top",
            "readonly","itemindex",
            "onselchanged","ondropdown","oncloseup","onnotification");
    end
    private
    function SetItemIndex(idx);override;
    begin
        FListBox.SetCurrentSelection(idx);
        InvalidateRect(nil,false);
    end
    function GetItemIndex();override;
    begin
        return FListBox.GetCurrentSelection();
    end
end
type TComboBox = class(TcustomComboBox)
    {**
    @explan(说明) comboBox下拉框 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","font","border","font","color",
            "visible","anchors","align","enabled","parentcolor","parentfont",
            "height","width","left","top",
            "readonly","items",
            "checkbox","multisel",
            "itemindex","dropdowncount","oncloseup","ondropdown","onselchanged","oneditchanged","onnotification");
    end
end 




type TToolButton = class(TcustomToolButton)
    {**
    @explan(说明) 工具栏项 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","action","caption","enabled","stylesep","imageid","visible","onclick","popupmenu","onnotification");
    end
end 

type TToolBar = class( TcustomToolBar)
    {**
    @explan(说明) 工具栏控件 %%   
    **}
    function create(AOwner);
    begin
        inherited;        
    end 
    function publishs();override;
    begin
        return array("name","align","caption","enabled","font","left","top","width","height",
            "visible","imagelist","mainmenu","onnotification");
        if Align <> alNone then
        begin
            return array("name","align","caption","enabled","font",
                "visible","imagelist");
        end else
        return array("name","align","caption","enabled","font","left","top","width","height",
            "visible","imagelist");
    end
end
type TStatusBar = class(TcustomStatusBar)
    {**
    @explan(说明) 状态栏 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","caption","enabled","border",
            "font","visible","items","ondblclick","onmousedown","onmouseup","onnotification");
    end
end 
type tcoolbar = class(tcustomcoolbar)
    {**
    @explan(说明) coolbar控件 %%   
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","enabled","caption","autosize","align","border","wsdlgmodalframe","font","color","dragbtncolor","visible","arrange","onnotification");
    end 
end 
type tsplitter = class(tcustomsplitter)
    {**
    @explan(说明) splitter 控件 %%   
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","enabled","border","left","top","width","height","color","parentcolor","transparent","visible","align","onnotification");
    end 
end 

	//树控件
type TTreeCtlNode = class( TcustomTreeCtlNode)
    {**
    @explan(说明) 树结点 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
end 


type TTreeNode=class(TTreeCtlNode)
    {**
    @explan(说明)tree控件节点 %%
    **}
    public
    function create(AOwner);override;
    begin
        inherited;
    end
    function GetSibling(id);
    begin
        {**
        @explan(说明) 获得兄弟节点%%
        @param(id)(integer) 序号,自己的位置为0%%
        **}
        r := nil;
        if id=0 then return self(true);
        if not(Parent is class(TTreeNode))then return r;
        if(id>-100000)and(id<100000)then
        begin
            idx := Parent.indexof(self);
            return Parent.GetNodeByIndex(idx+id);
        end
        return r;
    end
    function deletenode(nd);override;
    begin
        DeleteChildNode(nd);
    end
    function InsertSibling(node,ifprev);
    begin
        {**
        @explan(说明) 插入兄弟节点 %%
        @param(node)(TTreeNode) 待插入节点 %%
        @param(ifprev)(bool)
        **}
        if not(Parent is class(TTreeNode))then exit;
        idx := Parent.IndexOf(self);
        if ifprev then
        begin
            return Parent.InsertNode(node,idx);
        end else
        begin
            return Parent.InsertNode(node,idx+1);
        end
    end
    function Recycling();override;
    begin
        inherited;
    end
    function Destroy();override;
    begin
        inherited;
    end
    function moveup();virtual;
    begin
        {**
        @explan(说明) 节点上移 %%
        @return(bool) 是否移动成功 %%
        **}
        bf := GetSibling(-1);
        if not bf then return false;
        ndp := parent;
        nd := self(true);
        if ndp then
        begin
            ndp.deletenode(nd);
            ndp.insertnode(nd,bf);
            return true;
        end
        return false;
    end
    function movedown();virtual;
    begin
        {**
        @explan(说明) 节点下移%%
        **}
        bf := GetSibling(1);
        if not bf then return false;
        ndp := parent;
        if ndp then
        begin
            nd := self(true);
            ndp.deletenode(nd);
            ndp.insertnode(nd,ndp.indexof(bf)+1);
        end
        return false;
    end
    function insertbefor(node,befor);
    begin
        {**
        @ignore(忽略)
        **}
        insertnode(node,befor);
    end
    function append(node);
    begin
        {**
        @ignore(忽略)
        **}
        insertnode(node,self.ItemCount);
    end
    function deleteAllChild();
    begin
        DeleteChildren();
    end
    function InsertNode(node,bnode);override;
    begin
        {**
        @expaln(说明) 在子节点bnode 前面插入新的子节点node %%
        @param(node)(TTreeNode) 待插入节点 %%
        @param(bnode)(TTreeNode|TVI_FIRST|TVI_LAST) 基准节点 %%
        **}
        if ifarray(node)then return Owner.InsertNode(node,self(true),bnode);
        if ifnil(bnode)then bnode := TVI_LAST;
        ct := ItemCount;
        if bnode=TVI_LAST then
        begin
            pos := ct;
        end else
        if bnode=TVI_FIRST then
        begin
            pos := 0;
        end else
        if bnode is class(TTreeNode)then
        begin
            pos := IndexOf(bnode);
            if pos<0 then return 0;
        end else
        if bnode<ct and bnode >= 0 then
        begin
            pos := bnode;
        end else
        if bnode >= ct then
        begin
            pos := ct;
        end else
        begin
            pos := ct;
        end
        return inherited InsertNode(node,pos);
    end
    function GetNodeByPosition(id);
    begin
        {**
        @expaln(说明) 通过位置获得子节点%%
        **}
        return GetNodeByIndex(id);
    end
    function GetNodeCount();
    begin
        {**
        @explan(说明) 获得当前节点下所有节点数量 %%
        @return(integer) %%;
        **}
        r := 0;
        ct := ItemCount;
        for i := 0 to ct-1 do
        begin
            it := GetNodeByIndex(i);
            r += it.GetNodeCount();
        end
        r += ct;
        return r;
    end
    property items read Gitems;
end
type TTreeCtl = class(TcustomTreeCtl)
    {**
    @explan(说明) 树控件 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
end 
type TTreeView=class(TTreeCtl)
    {**
    @explan(说明) tree控件 %%
    **}
    private
    FBackColor;
    FHaveFocus;
    function SetLazyItems(v);
    begin
        if ifarray(v)and v["type"]="treenodes" then
        begin
            RootItem.RecyclingChildren();
            InsertNodes(v);
        end
    end
    function GetLazyItems();
    begin
        return(RootItem.toarray())["nodes"];
    end
    public
    function hasFocus();override;
    begin
        return FHaveFocus;
    end
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        inherited;
        if not FHaveFocus then
        begin
            SetFocus();
            FHaveFocus := true;
            InvalidateItem(self.CurrentNode);
        end
    end
    function WMKILLFOCUS(o,e);override;
    begin
        FHaveFocus := false;
        InvalidateItem(self.CurrentNode);
    end
    function create(AOwner);override;
    begin
        inherited;
        height := 150;
        border := true;
        HasLine := true;
        nodecreator := class(TTreeNode);
    end
    function expand(item);
    begin
        {**
        @explan(说明) 展开节点 %%
        @param(item)(TTreeNode) ;
        **}
        if item is class(TTreeNode) then item.Expand();
    end
    function collapse(item);
    begin
        {**
        @explan(说明) 收拢节点 %%
        @param(item)(TTreeNode) ;
        **}
        if item is class(TTreeNode)then item.UnExpand();
    end
    function SwitchCollapse(item);
    begin
        {**
        @explan(说明) 切换收拢或者展 %%
        @param(item)(TTreeNode) ;
        **}
        if item is class(TTreeNode)then
        begin
            if Item.Expaned then Item.UnExpand();
            else Item.UnExpand();
        end
    end
    function InsertNodes(iteminfos,pnode,bnode);
    begin
        {**
        @explan(说明) 批量插入节点 %%
        **}
        if ifarray(iteminfos)and iteminfos["type"]="treenodes" then
        begin
            its := iteminfos["items"];
            for i,v in its do
            begin
                InsertNode(v,pnode,bnode);
            end
        end
    end
    function InsertNode(iteminfo,pnode,bnode);
    begin
        {**
        @explan(说明)插入单个节点 %%
        @param(iteminfo)(array) array("type":"treenode","caption":"","imgid":id,"nodes":array()) 节点信息 
        nodes字段为子节点信息 %% 包括 
        %%
        @param(pnode)(TTreeNode) 父节点 %%
        @param(bnode)(TTreeNode) 前一个节点 %%
        **}
        if not(pnode is class(TTreeNode))then pnode := RootItem;
        if self <> pnode.Owner then return;
        if iteminfo is class(TTreeNode)then
        begin
            return pnode.InsertNode(iteminfo,bnode);
        end
        if not(ifarray(iteminfo)and iteminfo)then return nil;
        item := CreateTreeNode();
        item.Checked := iteminfo["checked"];
        item.caption := iteminfo["caption"];
        item.SelImgId := iteminfo["selimgid"];
        item.ImgId := iteminfo["imgid"];
        item._tag := iteminfo["tag"];
        pnode.InsertNode(item,bnode);
        InsertNodes(iteminfo["nodes"],item);
        return item;
    end
    function deleteitem(node);
    begin
        {**
        @explan(说明) 删除 节点,但是节点不会销毁,请用node.recycling 销毁 %% 
        @param(node)(TTreeNode)
        **}
        return deletenode(node);
        if node is class(TTreeNode)then
        begin
        end else
            return;
        np := RootItem.HasNode(node);
        if np then np.DeleteChildNode(node);
    end
    public
    function Recycling();override;
    begin
        inherited;
    end
    function Destroy();override;
    begin
        inherited;
    end
    function GetItemCount();
    begin
        {**
        @explan(说明) 获得item的数量 %%
        @return(integer) 数量 %%
        **}
        RootItem.GetNodeCount();
    end
    function clean();override;
    begin
        {**
        @explan(说明)删除节点并销毁 %%
        **}
        BeginUpdate();
        RootItem.RecyclingChildren();
        EndUpDate();
    end
    property RootItem read GetRootNode;
    property LazyItems:TreeData read GetLazyItems Write SetLazyItems;
    function publishs();override;
    begin
        return array("name",
            "left","top","width","height","caption","align","anchors",
            "checkbox","visible","itemheght","imagelist","hasline","singleexpand","color","font","parentcolor","parentfont",
            "lazyitems","onselchanged","onmousedown","onsetfocus","onkillfocus","onkeyup","onkeydown","onnotification");
    end
    //property OnDeleteItem read FOnDeleteItem write FOnDeleteItem;
    //property OnItemExpand:eventhandler read FOnItemExpand write FOnItemExpand;
    {**
    @param(RootItem)(TTreeNode) 根节点 %%
    @param(LazyItems)(array) 结构化数据数组 %% 
    **}
end
//tab控件
type TTabSheet = class(tcustomtabsheet)
    {**
    @explan(说明)page控件页面 %%
    **}    
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","caption","font","color","border","parentcolor","parentfont","wsdlgmodalframe","onsize","onnotification");
    end 
end 
type tpagecontrol = class(tcustompagecontrol)
    {**
    @explan(说明)page控件 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "align","anchors","color","font","parentcolor","parentfont","border","caption","popupmenu","enabled","visible","cursel","cursor",
            "wsdlgmodalframe","wssizebox","onpopupmenu","onselchange","onnotification");
    end
end 
//二分控件
type TPairSplitterSide=class(TCustomControl)
    {**
    @explan(说明) 分开控件side窗口 %%
    **}
    Private
    FPairSplitter;
    public
    function DesigningMove();override;
    begin
        return false;
    end
    function paint();override;
    begin
        inherited;
        drawdesigninggrid();
    end 
    function DesigningSizer();override;
    begin
        return false;
    end
    function Create(AOwner);override;
    begin
        inherited;
        caption := "PairSplitterSide";
        cursor := OCR_NORMAL;
        border := true;
    end
    function publishs();override;
    begin
        return array("name","border","caption","color","font","parentcolor","parentfont","popupmenu","bkbitmap","wsdlgmodalframe","onpopupmenu","onsize","onnotification");
    end
end
type TPairSplitter=class(tcustomcontrol) //
    {**
    @explan(说明)分割控件 %%
    **}
    private
    FDRageimglist;
    FWill_Drag;
    FIs_Draging;
    FPosition;
    FSides;
    FSplitterType;
    Fhimgelist;
    FEnables;
    function AddSide(ASide);//添加side
    begin
        if not(ASide is class(TPairSplitterSide))then return -1;
        FSides.Push(ASide);
    end
    function EnabledChild(f);//enabeld
    begin
        if f then 
        begin
            for i,v in FEnables do 
            begin
                if v then 
                begin
                    FSides[i].enabled := true;    
                end 
            end 
        end else 
        begin
            FEnables := array();
            for i,v in FSides.data do 
            begin
                FEnables[i] := v.enabled; 
                v.enabled := false;   
            end     
        end 
    end
    Function SetSplitterType(v);
    begin
        if (v in array(pstHorizontal,pstVertical)) and v <> FSplitterType then
        begin
            FSplitterType := v;
            if FSplitterType=pstVertical then cursor := OCR_SIZENS else cursor := OCR_SIZEWE;
            DoControlAlign();
        end
    end
    function GetPosition();
    begin
        if ifnil(FPosition)then
        begin
            if FSplitterType=pstHorizontal then
            begin
                FPosition := Width * 0.3;
            end else
            begin
                FPosition := Height * 0.7;
            end
        end
        return FPosition;
    end
    function SetPosition(AValue);
    begin
        if AValue>0 and AValue <> FPosition then
        begin
            FPosition := integer(AValue);
            DoControlAlign();
        end
    end
    function getvisbleside(id);
    begin
        c := 0;
        for i := 0 to fsides.length()-1 do 
        begin
            v := fsides[i];
            if v.Visible then 
            begin
                if c = id then return v;
                c++;
            end             
        end 
    end 
    public
    function ControlAppended(AControl);override; 
    begin
        if not FSides then return ;
        AddSide(AControl);
    end
    function ControlDeleted(AControl);override;
    begin
        if not FSides then return ;
        for i,v in FSides.data do 
        begin
            if v=AControl then 
            begin
                FSides.splice(i,1);  
                return ;  
            end 
        end 
    end
    function checknewchild(c);override;
    begin
        return c is class(TPairSplitterSide);
    end 
    function create(AOwner);override;
    begin
        inherited;       
    end
    function AfterConstruction();override;
    begin
        inherited;
        FSides := new tnumindexarray();
        caption := "pairspliter";
        width := 200;
        height := 200;
        Border := false;
        WsDlgModalFrame := true;
        FSplitterType := pstHorizontal;
        cursor := OCR_SIZEWE;
        FWill_Drag := true;
        Color := _wapi.GetSysColor(COLOR_MENUBAR);
    end 

    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then exit;
        if e.button=mbLeft then
        begin
            if FIs_Draging then
            begin
                _wapi.ImageList_DragLeave(self.Handle);
                _wapi.ImageList_EndDrag();
                r := ClientRect;
                if FSplitterType=pstHorizontal then
                begin
                    x := e.xpos ;
                    if x<(r[0]+2) then 
                    begin
                        x := r[0]+5;
                    end else
                    if x>(r[2]-2) then 
                    begin
                        x := r[2]-5;
                    end 
                    FPosition := x;
                end else
                begin
                    x :=  e.ypos;
                    if x<(r[1]+2) then 
                    begin
                        x := r[1]+5;
                    end else
                    if x>(r[3]-2) then 
                    begin
                        x := r[3]-5;
                    end                     
                    FPosition :=x;
                end
                EnabledChild(true);
                FWill_Drag := true;
                FIs_Draging := false;
                _wapi.clipcursor(0);
                DoControlAlign();
            end
        end
        inherited;
    end
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then exit;
        if e.button=mbLeft then
        begin
            nxy := clienttowindow(e.xpos,e.ypos);
            if FWill_Drag then
            begin
                FWill_Drag := false;
                FIs_Draging := true;
                if FDRageimglist then _wapi.ImageList_Destroy(FDRageimglist);
                crect := clientrect;
                if FSplitterType=pstHorizontal then
                begin
                    FDRageimglist := _wapi.ImageList_Create(5,crect[3],ILC_COLOR16 .| ILC_MASK,5,1);
                    _wapi.ImageList_BeginDrag(FDRageimglist,0,2,nxy[1]);
                end else
                begin
                    FDRageimglist := _wapi.ImageList_Create(crect[2],5,ILC_COLOR16 .| ILC_MASK,5,1);
                    _wapi.ImageList_BeginDrag(FDRageimglist,0,nxy[0],2);
                end
                _wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
                //_wapi.ImageList_DragEnter(self.Handle,e.xpos,e.ypos);
                ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
                _wapi.clipcursor(ps);
                EnabledChild(false);
            end
        end
        inherited;
    end
    function MouseMove(o,e);override;
    begin
        if (csDesigning in ComponentState) then return ;
        if FIs_Draging then
        begin
            nxy := clienttowindow(e.xpos,e.ypos);
            _wapi.ImageList_DragMove(nxy[0],nxy[1]);
        end else
        begin
            if getvisbleside(0) then 
            begin 
                if FSplitterType=pstHorizontal then 
                begin
                    cursor := OCR_SIZEWE;
                end else 
                if FSplitterType=pstVertical then 
                begin
                    cursor := OCR_SIZENS ;
                end                  
            end else 
            begin
                cursor := OCR_NORMAL;
            end 
        end 
        inherited;
    end
    function DoControlAlign();override;
    begin
        {**
        @explan(说明) 对齐调整 %%
        **}
        if not HandleAllocated()then return;
        sd1 := getvisbleside(0);
        sd2 := getvisbleside(1);
        if not(sd1 or sd2)then return;
        rc := GetClientRect();
        pz := GetPosition();
        pbdr := 0;
        {$ifdef linux}
        if (csDesigning in ComponentState) then 
        begin
            pbdr := 2; 
        end 
        {$endif}
        if sd1 and sd1.HandleAllocated()then
        begin
            if FSplitterType=pstHorizontal then sd1.setboundsrect(array(rc[0]+pbdr,rc[1]+pbdr,rc[0]+pz,rc[3]-pbdr));
            else sd1.setboundsrect(array(rc[0]+pbdr,rc[1]+pbdr,rc[2]-pbdr,rc[1]+pz));
        end
        if sd2 and sd2.HandleAllocated()then
        begin
            if FSplitterType=pstHorizontal then sd2.setboundsrect(array(rc[0]+pz+4,rc[1]+pbdr,rc[2]-pbdr,rc[3]-pbdr));
            else sd2.setboundsrect(array(rc[0]+pbdr,rc[1]+pz+4,rc[2]-pbdr,rc[3]-pbdr));
        end
    end
    function paint();override;
    begin
        sd1 := getvisbleside(0);
        sd2 := getvisbleside(1);
        if not(sd1 or sd2)then return;
        rc := GetClientRect();
        pz := GetPosition();
        dc := canvas;
        if FSplitterType=pstHorizontal then 
        begin 
            x := rc[0]+pz+2;
            y := integer(rc[1]+(rc[3]-rc[1])/2) ;
            for i := -4 to 4 do 
            begin
                y1 := y+i*4;
                if y1>rc[1] and y1<rc[3] then 
                    dc.SetPixel(array(x,y1),0);
            end        
        end else 
        begin
            y := rc[1]+pz+2;
            x := integer(rc[0]+(rc[2]-rc[0])/2) ;
            for i := -4 to 4 do 
            begin
                x1 := x+i*4;
                if x1>rc[0] and x1<rc[2] then 
                    dc.SetPixel(array(x1,y),0);
            end  
        end         
    end 
    function Recycling();override;
    begin
        if FDRageimglist then _wapi.ImageList_Destroy(FDRageimglist);
        FSides := nil;
        inherited;
    end    
    property Position:integer read GetPosition write SetPosition;
    property SplitterType:SplitterType read FSplitterType write SetSplitterType;
    function publishs();override;
    begin
        return array("name","left","top","width","height",
            "align","anchors","border","color","font","caption","enabled","visible","parentcolor","parentfont","splittertype","position",
            "wsdlgmodalframe","wscaption","wspopup","wssizebox","wssysmenu","onnotification");
    end
    {**
    @param(Position)(integer) 分割线位置 %%
    @param(SplitterType)(menuber of TPairSplitterType) 分割线位置 %%
    **}
end

	//表格控件
type TTlvnActiveEvent=class(tuieventbase)
    {**
    @explan(说明) listview active 通知消息 %%
    **}
    public
    function create(m,w,l,h);override;
    begin
        inherited;
        FNmList := array();
    end
    property hdr index "hdr" read _getvalue_ write _setvalue_;
    property iitem index "iitem" read _getvalue_ write _setvalue_;
    property isubitem index "isubitem" read _getvalue_ write _setvalue_;
    property unewstate index "unewstate" read _getvalue_ write _setvalue_;
    property uoldstate index "uoldstate" read _getvalue_ write _setvalue_;
    property uchanged index "uchanged" read _getvalue_ write _setvalue_;
    property ptaction index "ptaction" read _getvalue_ write _setvalue_;
    property lparam index "lparam" read _getvalue_ write _setvalue_;
    private
    FNmList;
    function _getvalue_(n);
    begin
        return FNmList[n];
    end
    function _setvalue_(n,v);
    begin
        FNmList[n] := v;
    end
end

type TGridCtl = class(TcustomGridCtl)
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","height","width","left","top","border","anchors","align","font","color","parentcolor","parentfont",
            "autoscroll","columncount","itemcount",
            "itemheight","variablerows","mousesizecell","fixedrows","fixedcolumns","mergeinfo",
            "ondrawcell","onhitcellsizer","onmousewheel","onmousemove",
            "onmousedown","onmouseup","ondblclick",
            "onkeyup","onkeydown","onkeypress","onnotification");
    end  
end 

type TGRidBase = class(TGridCtl)
    {**
    @explan(说明)表格基础类 %%
    **}
    private
    FGridLine;
    FColumHeader;
    FonColumnClick;
    FColumTexts;
    private
    function setcolumncount(n);override;
    begin
    end
    function SetGridLine(v);
    begin
        nv := v?true:false;
        if nv <> FGridLine then
        begin
            FGridLine := nv;
        end
    end
    function SetColumHeader(v);
    begin
        nv := v?true:false;
        if nv <> FColumHeader then
        begin
            ct := ItemCount;
            FColumHeader := nv;
            if nv then
            begin
                FixedRows := 1;
            end else
            FixedRows := 0;
            ItemCount := ct;
        end
    end
    
    function SetItemCount(r);
    begin
        if r >= 0 then
        begin
            if ColumnHeader then
            begin
                class(TGridCtl).ItemCount := r+1;
            end else
            class(TGridCtl).ItemCount := r;
        end
    end
    function GetItemCount();
    begin
        if ColumnHeader then
        begin
            return class(TGridCtl).ItemCount-1;
        end else
        return class(TGridCtl).ItemCount;
    end
    function GetColumInfo();
    begin
        r := array();
        for i := 0 to FColumTexts.Length()-1 do
        begin
            r[i,"text"]:= FColumTexts[i];
            r[i,"width"]:= GetColumnWidth(i);
        end
        return r;
    end
    protected
    function GetColumns();virtual;
    begin
        return GetColumInfo();
    end
    function ClickedGridItem(o,e);virtual;
    begin
        {**
        @explan(说明)点击时处理 %%
        **}
    end
    function RClickedGridItem(o,e);virtual;
    begin
        {**
        @explan(说明)点击时处理 %%
        **}
    end
    function CreateVclick(o,e);
    begin
        ne := new TTlvnActiveEvent(100,0,0,o.handle);
        ne.iitem := GetRowIndexByPos(e.ypos);
        ne.isubitem := GetColIndexByPos(e.xpos);
        ne.ptaction := array(e.xpos,e.ypos);
        return ne;
    end
    public
    function GetRowIndexByPos(y);override;
    begin
        r := inherited;
        if r >= 0 and FColumHeader then r--;
        return r;
    end
    function Create(AOwner);override;
    begin
        inherited;
        caption := "grid";
        FixedRows := 1;
        FGridLine := true;
        FColumHeader := true;
        ItemCount := 0;
        Visible := true;
        FColumTexts := new TMyarrayB();
    end
    function Recycling();override;
    begin
        onColumnClick := nil;
        inherited;
    end
    function GetSubItemRect(i,j);override;
    begin
        {**
        @explan(说明)获得子项的区域 %%
        @return(array) array(左,上,右,下);
        **}
        i1 := i;
        if FColumHeader then
        begin
            i1 := i+1;
        end
        r := inherited GetSubItemRect(i1,j);
        if not r then return zeros(4);
        return r;
    end
    function InvalidateItem(i);override;
    begin
        i1 := i;
        if FColumHeader then i1++;
        inherited InvalidateItem(i1);
    end
    function GetItemRect(id);override;
    begin
        {**
        @explan(说明) 获得行的区域 %%
        @return(array) array(左,上,右,下);
        **}
        i1 := id;
        if FColumHeader then
        begin
            i1 += 1;
        end
        r := inherited GetItemRect(i1);
        if r then return r;
        return array(0,0,0,0);
    end
    function HitTestItem(x,y)
    begin
        {**
        @explan(说明)位置命中 测试 %%
        **}
        i := GetRowIndexByPos(y);
        return array(i,ifnumber(x)?GetColIndexByPos(x):0);
    end
    function SetColumns(cs,beg,len);override;
    begin
        if not cs then
        begin
            FColumTexts.splices(beg>0?beg:0,len >= 0?len:FColumTexts.Length(),array());
            Inherited SetColumns(array(),beg,len);
            return;
        end
        if ifarray(cs)then
        begin
            wds := array();
            cls := array();
            idx := 0;
            for i,v in cs do
            begin
                if ifarray(v)and ifstring(v["text"])then
                begin
                    wd := v["width"];
                    owd := GetColumnWidth(i);
                    wds[idx]:= v["width"]>= 0?v["width"]:(owd >= 0?owd:100);
                    cls[idx++]:= v["text"];
                end
            end
            owds := array();
            for i := 0 to ColumnCount-1 do
            begin
                owds[i]:= GetColumnWidth(i);
            end
            if(cls=FColumTexts.Data)and(owds=wds)then exit;
            if ifnil(beg)and ifnil(len)then DeleteAllColumns();
            FColumTexts.splices(beg>0?beg:0,len >= 0?len:FColumTexts.Length(),cls);
            Inherited SetColumns(wds,beg,len);
        end
    end
    function DeleteColumn(i);virtual;
    begin
        {**
        @explan(说明) 删除某列
        **}
        SetColumns(array(),i,1);
    end
    function InSertColumn(txt,wd,idx);virtual;
    begin
        {**
        @explan(说明) 插入列 %%
        @param(txt)(string) 标题 %%
        @param(wd)(integer) 宽度 %%
        @param(idx)(integer) 插入在序号之前%%
        **}
        if not(ifstring(txt)and wd >= 0)then return-1;
        if idx >= 0 then p := idx;
        else p := ColumnCount;
        SetColumns(array(("text":txt,"width":wd)),p,0);
    end
    function DeleteAllColumns();virtual;
    begin
        {**
        @explan(说明) 删除所有列 %%
        **}
        DeleteAllItems();
        SetColumns(array(),nil,nil);
    end
    function DeleteAllItems();virtual;
    begin
        {**
        @explan(说明) 清空内容 %%
        **}
        ItemCount := 0;
    end
    function DeleteItem(i);virtual;
    begin
        ItemCount := ItemCount-1;
    end
    function InsertItem(item);virtual;
    begin
        ItemCount := ItemCount+1;
    end
    function SetColumnText(n,t);
    begin
        FColumTexts[n]:= t;
    end
    function GetColumnText(n);
    begin
        return FColumTexts[n];
    end
    function clean();
    begin
        {**
        @explan(说明) 清空所有项目以及表头 %%
        **}
        DeleteAllColumns();
    end
    function DrawHeader(o,e);virtual;
    begin
        rec := e.rcitem;
        cvs := e.canvas;
        j := e.Subitemid;
        dr := array(rec[0:1],rec[2:3]);
        cvs.Draw("FrameControl",dr,DFC_BUTTON,DFCS_BUTTONPUSH);
        cs := GetColumnText(j);
        if ifstring(cs)then cvs.drawtext(cs,rec,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
    end
    function DrawCell(cvs,rec,i,j);override; //绘制表头
    begin
        if not HandleAllocated()then return;
        //构造消息对象
        e := new TGRIDMDRAWITEM(WM_DRAWITEM,0,0,0);
        e.canvas := cvs;
        if FColumHeader then e.itemid := i-1;
        else e.itemid := i;
        e.rcitem := rec;
        e.SubItemRect := rec;
        e.Subitemid := j;
        if FColumHeader and i=0 then
        begin
            return DrawHeader(self(true),e);
        end
        DoDrawItem(self(true),e);
    end
    function DoDrawItem(o,e);virtual;
    begin
        DoDrawSubItem(o,e);
    end
    function DoDrawSubItem(o,e);virtual;
    begin
        if FGridLine then
        begin
            rc := e.rcitem;
            dc := e.canvas;
            dc.Pen.Color := 0xc8c8c8;
            dc.moveto(array(rc[2],rc[1]));
            dc.LineTo(array(rc[2],rc[3]));
            dc.LineTo(array(rc[0],rc[3]));
            if e.Subitemid=0 then
            begin
                dc.LineTo(array(rc[0],rc[1]));
            end
            if e.itemid=0 then
            begin
                dc.MoveTo(array(rc[0],rc[1]));
                dc.LineTo(array(rc[2],rc[1]));
            end
        end
    end
    function DoSelectChanged(o,nindex,oindex);virtual;
    begin
    end
    function MouseDown(o,e);override;
    begin
        r := inherited;
        if r then return r;
        if e.shiftdouble()and e.button()=mbLeft then //双击 
        begin
            ne := CreateVclick(o,e);
            ClickedGridItem(o,ne);
            CallMessgeFunction(ondblclick,o,ne);
        end
    end
    function MouseUp(o,e);override;
    begin
        r := inherited;
        if r then return r;
        ne := CreateVclick(o,e);
        bt := e.button();
        if bt=mbRight then
        begin
            RClickedGridItem(o,ne);
            CallMessgeFunction(onrclick,o,ne);
        end else
        if bt=mbLeft then
        begin
            if FColumHeader and(inherited GetRowIndexByPos((ne.ptaction)[1]))=0 then
            begin
                CallMessgeFunction(onColumnClick,o,ne);
            end else
            begin
                ClickedGridItem(o,ne);
                CallMessgeFunction(onclick,o,ne);
            end
        end
        //e.skip := true;
        //rclick
        //click 
        //LVN_COLUMNCLICK
    end
    property GridLine:bool read FGridLine write SetGridLine;
    property ColumnHeader:bool read FColumHeader write SetColumHeader;
    property ItemCount:integer read GetItemCount write SetItemCount;
    property onColumnClick:eventhandler read FonColumnClick write FonColumnClick;
    property Columns:statusitems read GetColumns write SetColumns;
    {
    @param(GridLine)(bool) 是否有网格线 %%
    @param(ColumnHeader)(bool) 是否有表头 %%
    @param(color)(integer) 颜色 %%
    @param(onColumnClick)(function[TGRidBase,TTlvnActiveEvent]) 列被点击 %%	
    }
end 
type TDrawGrid=class(TGRidBase)
    {**
    @explan(说明)自绘制网格 %%
    **}
    Private
    FOnDoDrawSubItem;
    protected
    public
    function Create(AOwner);override;
    begin
        inherited;
    end
    function DoDrawSubItem(o,e);override;
    begin
        inherited;
        if OnDoDrawSubItem then 
            CallMessgeFunction(OnDoDrawSubItem,o,e);
    end
    function Recycling();override;
    begin
        FOnDoDrawSubItem := nil;
        inherited;
    end
    property OnDoDrawSubItem read FOnDoDrawSubItem write FOnDoDrawSubItem;
    {**
    @param(OnDoDrawSubItem)(function[tdrawgrid,TGRIDMDRAWITEM]) 子项绘制 %%
    @param(ItemCount)(integer) 行数 %%
    **}
end

type TListView = class(TDrawGrid)
    {**
    @explan(说明) listview控件 %%
    **}
    private
    FMouseCurrentTime;
    FList;
    FIntAlign;
    FSelected;
    FMoueonItem;
    FSelBkColor;
    FMouseOnBkColor;
    FMenus;
    FSelectedChanged;
    FOnCheckItem;
    FCanSelected;
    FColumnBool;
    FPrevSelectedId;
    Function SetIntAlign(v);
    begin
        if v in array(DT_CENTER,DT_LEFT,DT_RIGHT)then
        begin
            if v <> FIntAlign then
            begin
                FIntAlign := v;
                InvalidateRect(nil,false);
            end
        end
    end
    function CallSelChanged();
    begin
        if OnSelChanged then 
        return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
    end
    function SetCanSelected(v);
    begin
        vn := v?true:false;
        if FCanSelected <> vn then
        begin
            FCanSelected := vn;
            if not UnSelected then UnSelected();
        end
    end
    function SetSelected(id);
    begin
        if not FCanSelected then exit;
        if id=FSelected then exit;
        if id<0 then exit;
        odid := FSelected;
        FPrevSelectedId := odid;
        FSelected := id;
        if odid >= 0 then
        begin
            InvalidateItem(odid);
        end
        InvalidateItem(id);
        CallSelChanged();
    end
    function GetSelected();
    begin
        if FSelected >= 0 then return FList[FSelected];
        return nil;
    end
    
    function GetListValues();
    begin
        r := array();
        for i := 0 to FList.count-1 do
        begin
            r[i]:= FList[i];
        end
        return r;
    end
    function CreateMenu();
    begin
        if FMenus then return FMenus;
        createmenubyarray(menus(),FMenus);
        return FMenus;
    end
    function createmenubyarray(ms,pm);
    begin
        if not(ifarray(ms)and ms)then exit;
        if ms["type"]="menu" then
        begin
            if not pm then pm := new TPopUpmenu(FCwnd);
            if ifstring(ms["caption"])then
            begin
                mu := new tmenu(FCwnd);
                mu.caption := ms["caption"];
                o := ms["onclick"];
                mu.onclick := ms["onclick"];
                mu.parent := pm;
                call(thisfunction,ms["items"],mu);
            end
        end else
        for i,v in ms do
        begin
            call(thisfunction,v,pm);
        end
    end
    public
    function menus();virtual;
    begin
        {**
        @explan(说明) 返回菜单数组 %%
        @return(array) array(("type":"menu","caption":"删除")
        ,("type":"menu","caption":"添加"))
        **}
        return array();
        return array(("type":"menu","caption":"删除")
            ,("type":"menu","caption":"添加"));
    end
    function DeleteAllItems();override;
    begin
        {**
        @explan(说明) 清空内容 %%
        **}
        UnSelected();
        FList.clean();
        inherited;
    end
    function GridDrawItem(id);
    begin
        {**
        @explan(说明) 绘制第id项 %%
        **}
        InvalidateItem(id);
    end
    function SetSelectedValue(v);
    begin
        {**
        @explan(说明) 设置选中项目 %%
        **}
        id := FList.indexof(v);
        if id >= 0 and id<FList.Count then SetSelected(id);
    end
    function MouseMove(o,e);override;
    begin
        return inherited;
        {r := inherited;
        if r then return r;
        t := now();
        if(t-FMouseCurrentTime)<1/24/60/60/5 then return;
        FMouseCurrentTime := t;
        if(FMouseOnBkColor=rgb(255,255,255))or not(ifnumber(FMouseOnBkColor))then exit;
        item := HitTestItem(e.xpos,e.ypos);
        if not item then exit;
        id := item[0];
        if id >= 0 and id <> FMoueonItem then
        begin
            odid := FMoueonItem;
            FMoueonItem := id;
            if odid >= 0 and odid <> FSelected then
            begin
                InvalidateItem(odid);
            end
            if id <> FSelected then
            begin
                InvalidateItem(id);
            end
        end}
    end
    protected
    function ClickedGridItem(o,e);override;
    begin
        {**
        @explan(说明)点击时处理 %%
        **}
        id := e.iitem;
        j := e.isubitem;
        BJ := FColumnBool[j];
        if BJ then
        begin
            if ifarray(BJ)and BJ[1]then
            begin
                it := o.GetItem(id);
                if ifarray(it)then
                begin
                    idx := mrows(it,1)[j];
                    if ifnumber(idx)or ifstring(idx)then
                    begin
                        tti := it[idx];
                        if tti=inf or tti=-inf then exit;
                        it[idx]:= not tti;
                        o.SetItem(id,it);
                        rec := o.GetSubItemRect(i,j);
                        o.InvalidateRect(rec,false);
                        return;
                    end
                end
            end
        end
        return SetSelected(id);
    end
    function RClickedGridItem(o,e);override;
    begin
        {**
        @explan(说明)点击时处理 %%
        **}
        id := e.iitem;
        return SetSelected(id);
    end
    public
    function DoDrawItem(o,e);override; //
    begin
        {
        @explan(说明) 绘制 %% 
        }
        if not Visible then exit;
        if FSelected=e.itemid then
        begin
            if ifnumber(SelBkColor)then e.canvas.brush.color := SelBkColor;
            else e.canvas.brush.color := 0xffffff;//rgb(255,255,255);
        end else
        if FMoueonItem=e.itemid then
        begin
            if ifnumber(MouseOnBkColor)then e.canvas.brush.color := MouseOnBkColor;
            else e.canvas.brush.color := 0xffffff;//rgb(255,255,255);
        end else
        begin
            e.canvas.brush.color := 0xffffff;//rgb(255,255,255);
        end
        rec := e.rcitem;
        rec[0]+= 1;
        rec[1]+= 1;
        rec[2]-= 1;
        rec[3]-= 1;
        e.canvas.fillrect(rec);
        DoDrawSubItem(o,e);
    end
    function moveup();
    begin
        {**
        @explan(说明) 选中项上移 %%
        **}
        sd := FSelected;
        if sd>0 then
        begin
            FList.swap(sd,sd-1);
            FSelected -= 1;
            GridDrawItem(sd);
            GridDrawItem(sd-1);
        end
    end
    function movedown();
    begin
        {**
        @explan(说明) 选中项下移 %%
        **}
        sd := FSelected;
        if sd >= 0 and sd<FList.Count-1 then
        begin
            FList.swap(sd,sd+1);
            FSelected += 1;
            GridDrawItem(sd);
            GridDrawItem(sd+1);
        end
    end
    function deletebyid(id);
    begin
        {**
        @explan(说明) 根据 序号删除项目 %%
        **}
        if not(id >= 0 and id<FList.Count)then exit;
        SetSelected(id);
        deleteselect();
    end
    function finditemid(v);virtual;
    begin
        {**
        @explan(说明) 根据类容查找序号  %%
        @return(integer) 序号 ,没找到返回 -1
        **}
        r :=-1;
        for i := 0 to FList.Count-1 do if v=FList[i]then return i;
        return r;
    end
    function deletebyvalue(v);virtual;
    begin
        {**
        @explan(说明) 根据 值删除 %%
        **}
        deletebyid(FList.indexof(v));
    end
    function deleteselect();
    begin
        {**
        @explan(说明) 删除选中项 %%
        **}
        sd := FSelected;
        return DeleteItem(sd);
        if sd >= 0 then
        begin
            FMoueonItem := nil;
            FList.deli(sd);
            ct := FList.Count-1;
            if sd>ct then
            begin
                FPrevSelectedId := FSelected;
                FSelected := ct;
                CallSelChanged();
            end
            deleteitem(sd);
        end
    end
    function create(AOwner);override;
    begin
        inherited;
        FMouseCurrentTime := 0;
        FIntAlign := DT_RIGHT;
        border := true;
        FList := new TFpList();
        SelBkColor := 0xface87;//0xffbf00;//0xB0E0E6; //rgb(200,200,0);
        ItemHeight := 30;
        //MouseOnBkColor := nil;// 0xface87;//0xF8F8FF; //rgb(0,200,200); 
        CreateMenu();
        PopupMenu := FMenus;
        FCanSelected := true;
        FPrevSelectedId :=-1;
        FColumnBool := array();
    end
    function CheckItem(v);virtual;
    begin
        {**
        @explan(说明) 检查项目 %%
        **}
        if datatype(FOnCheckItem)=7 then
        begin
            return call(FOnCheckItem,v);
        end
        return true;
    end
    function InsertItem(v,id);virtual;
    begin
        {**
        @explan(说明) 在序号id处面插入项目 %%
        @param(v)() 待插入的项目 %%
        @param(id)(integer) 插入位置 %%
        **}
        if CheckItem(v)then
        begin
            if id >= 0 and id <= FList.Count+1 then
            begin
                FList.insertafter(v,id-1);
                ItemCount := FList.Count;
                if FSelected >= 0 and(id-1)<FSelected then
                begin
                    FSelected += 1;
                end
            end
        end
    end
    function InsertItemAfter(v,id);virtual;
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) 在序号id后面插入项目 %%
        @param(v)() 待插入的项目 %%
        @param(id)(integer) 插入位置 %%
        **}
        if CheckItem(v)then
        begin
            if id >= 0 and id <= FList.Count then
            begin
                FList.insertafter(v,id);
                ItemCount := FList.Count;
                if FSelected >= 0 and id<FSelected then
                begin
                    FSelected += 1;
                end
            end
        end
    end
    function AppendItem(v);virtual;
    begin
        {**
        @explan(说明) 追加项 %%
        **}
        if CheckItem(v)then
        begin
            FMoueonItem := nil;
            FList.append(v);
            ItemCount := FList.Count;
            //inherited InsertItem(self.ItemCount);
        end
    end
    function SetsubItem(idx,subid,v);
    begin
        {**
        @explan(说明)设置子项 %%
        @param(subid)(string|integer) 下标 %%
        @param(v)(any) 值 %%
        **}
        it := GetItem(idx);
        if not ifarray(it)then exit;
        it[subid]:= v;
        SetItem(idx,it);
    end
    function SetSubItemByIndex(idx,subidx,v);
    begin
        {**
        @explan(说明)通过序号设置子项 %%
        @param(subid)(integer) 下标 %%
        @param(v)(any) 值 %%
        **}
        it := GetItem(idx);
        if not ifarray(it)then exit;
        vid := mrows(it,1)[subidx];
        if ifnumber(vid)or ifstring(vid)then
        begin
            it[vid]:= v;
        end
        SetItem(idx,it);
    end
    function GetItem(idx);
    begin
        {**
        @explan(说明) 获得项 %%
        @param(idx)(integer) 序号 %%
        @param(v)(any) 值%%
        **}
        idx := integer(idx);
        if idx >= 0 and idx<FList.Count then
        begin
            return FList[idx];
        end
    end
    function SetItem(idx,v);virtual;
    begin
        {**
        @explan(说明) 修改值 %%
        @param(idx)(integer) 序号 %%
        @param(v)(any) 任何数据 %%
        **}
        idx := integer(idx);
        if idx >= 0 and idx<FList.Count then
        begin
            if CheckItem(V)then
            begin
                vi := FList[idx];
                if vi <> v then
                begin
                    FList.seti(idx,v);
                    if HandleAllocated()then
                    begin
                        rec := GetItemRect(idx);
                        InvalidateRect(rec,false);
                    end
                end
            end
        end
    end
    function DeleteItem(i);override;
    begin
        sd := i;
        if sd >= 0 and sd<FList.Count then
        begin
            FMoueonItem := nil;
            FList.deli(sd);
            dsf := sd=FSelected;
            if sd <= FSelected then
            begin
                FSelected := FSelected-1;
                if dsf >= 0 then FPrevSelectedId := dsf;
                CallSelChanged();
            end
            inherited;
        end
    end
    function AppendItems(arr);
    begin
        {**
        @expaln(说明) 追加多个项目 %%
        @param(arr)(array) 项数组 %%
        **}
        cv := array();
        FMoueonItem := nil;
        for i,v in arr do
        begin
            if CheckItem(v)then
            begin
                FList.append(v);
            end
        end
        ItemCount := FList.Count;
    end
    function DoDrawSubItem(o,e);override;
    begin
        {**
        @explan(说明) 绘制子项 %%
        **}
        inherited;
        if e.skip then exit;
        dc := e.canvas;
        if not dc.Handle then exit;
        i := e.itemid;
        di := FList[i];
        if not ifarray(di)then exit;
        j := e.subitemid;
        iddx := mrows(di,1)[j];
        if ifnil(iddx)then exit;
        dij := di[iddx];
        src := e.subItemRect;
        if FColumnBool[j]then
        begin
            //src[0] :=  src[2]-20-10;
            //src[2]-=10;
            src[1]+= 3;
            src[3]-= 3;
            v := List[i];
            if ifarray(v)then
            begin
                if dij=-inf then dij := false;
                else if dij=inf then dij := true;
                rrx := integer(src[0]-10+(src[2]-src[0])/2);
                rry := integer(src[1]-10+(src[3]-src[1])/2);
                dc.Draw("framecontrol",array((rrx,rry),(rrx+18,rry+18)),DFC_BUTTON,dij?DFCS_CHECKED:DFCS_BUTTONCHECK);
                //_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,dij?DFCS_CHECKED:DFCS_BUTTONCHECK);
            end
        end else
        begin
            if ifstring(dij)and dij then
            begin
                dc.font := font;
                dc.DrawText(dij,src,DT_VCENTER .| DT_LEFT .| DT_SINGLELINE .| DT_NOPREFIX);
            end else
            if ifnumber(dij)then
            begin
                dc.font := font;
                dc.DrawText(tostn(dij),src,DT_VCENTER .| FIntAlign .| DT_SINGLELINE .| DT_NOPREFIX);
            end
        end
    end
    function SetSelectedByValue(v);virtual;
    begin
        {**
        @explan(说明) 通过值确定选中项
        **}
        if ifnil(v)then UnSelected();
        for i := 0 to List.Count-1 do
        begin
            if v=List[i]then
            begin
                SelectedId := i;
            end
        end
    end
    function ColumnAsBool(n,f,ce);
    begin
        {**
        @expaln(说明) 设置某列为bool %%
        @param(n)(integer) 列号 %%
        @param(f)(bool) 取消或者设置,默认为true %%
        @param(ce)(bool) 是否可以编辑 %%
        **}
        if not(n >= 0)then exit;
        //if not ifarray(FColumnBool) then FColumnBool := array();
        nv := ifnil(f)?:(f?true:false);
        ov := FColumnBool[n];
        ov := ov?true:false;
        if ov <> nv then
        begin
            FColumnBool[n]:= array(nv,ce);
            if HandleAllocated()and n<ColumnCount then
            begin
                InValidateRect(nil,true);
            end
        end
    end
    function Recycling();override;
    begin
        SelectedChanged := nil;
        OnCheckItem := nil;
        FMenus := nil;
        DeleteAllItems();
        inherited;
    end
    function UnSelected();
    begin
        {**
        @explan(说明) 取消选择 %%
        **}
        if FSelected >= 0 then
        begin
            sd := FSelected;
            FPrevSelectedId := sd;
            Fselected :=-1;
            GridDrawItem(sd);
            //calldatafunction(SelectedChanged,self(true));
        end
    end
    property SelectedChanged read FSelectedChanged write FSelectedChanged;
    property OnSelChanged:eventhandler read FSelectedChanged write FSelectedChanged;
    property List read FList;
    property CanSelected read FCanSelected write SetCanSelected;
    property SelectedId:integer read Fselected write SetSelected;
    property PrevSelectedId read FPrevSelectedId;
    property SelectedValue read GetSelected;
    property SelBkColor:color read FSelBkColor write FSelBkColor;
    property MouseOnBkColor:color read FMouseOnBkColor write FMouseOnBkColor;
    property ListValues read GetListValues;
    property OnCheckItem:eventhandler read FOnCheckItem write FOnCheckItem;
    property NumberAlign read FIntAlign write SetIntAlign;
    function publishs();override;
    begin
        return array("name","height","width","left","top","border","anchors","align","font","color","parentcolor","parentfont",
            "autoscroll","itemheight","columns","columncount","itemcount","mousesizecell",
            "fixedrows","fixedcolumns",
            "gridline","columnheader",
            "selectedid","selbkcolor","mouseonbkcolor",
            "onmousewheel","onmousemove",
            "onmousedown","onmouseup","ondblclick",
            "onkeyup","onkeydown","onkeypress","oncolumnclick","oncheckitem","onnotification");
    end
    {**
    @param(SelectedId)(integer) 当前选中的序号,<0表示没有选中项 %%
    @param(PrevSelectedId)(integer) 选择切换前面的选中id %%
    @param(onselchanged)(function[tlistview]) 选中改变回调 %%
    @param(SelectedValue)(any) 选中项的值 %%
    @param(SelBkColor)(integer) 颜色rgb值 %%
    @param(MouseOnBkColor)(integer) 颜色rgb值 %%
    @param(ListValues)(array) 数据 %%
    @param(OnCheckItem)(function[any]:bool) 添加数据时的检测的回调 %%
    **}
end

	

	//其他控件
type tprogressbar = class(tcustomprogressbar)
    {**
        @explan(说明) 进度栏
        进度栏是显示任务进行完成度的控件。进度栏的上下限是进度条位置可移动的
        范围，可以通过range属性获取、修改，其默认值是array(0,100)。进度条的位置可以通过
        position属性获取、修改。进度栏的步增量是其每次调用increaseByStep函数进度条
        位置移动的量，可以通过step属性获取、修改，其默认值是10.
        进度条默认是分段离散的，可通过修改smooth成员设置其为平滑连续的。默认是
        水平从左到右移动，可通过修改vertical成员来设置其为垂直从底部到顶部移动。
    **} 
    function Create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","border",
                "align","anchors",
                "popupmenu","color","visible","enabled","parnetcolor",
                "height","width","left","top",
                "vertical","smooth","range","position","barcolor","onmousemove","onpopupmenu",
                "onmousedown","onmouseup","onnotification");
    end 

end 
type tmonthcalendar = class(TCustomControl)
{**
			@explan(说明)月历控件
			该控件的函数可能的返回值：
			array等期望的数据/1：成功。
			-1：一般是函数参数格式不正确。
			nil：该项属性在控件种类正确、窗口未创建、无默认值的情况下未设置过或被重置过。
			0：失败，可能的原因：
					1.参数格式正确但不适用于控件的当前状态，如对多选月历设置当前选择项时项数超过其最大多选项数限制。
					2.控件类型错误，如对单选月历调用设置其最大多选项数限制的函数。
					3.要求控件创建后才可调用的函数在控件创建之前被调用。
					4.未知错误。
		**}
    function create(aowner);
    begin
        inherited;          
        //TodayButton := false;     
    end 
    function AfterConstruction();override;
    begin
        inherited;
        width := 213;
        height := 175;
        FCalender := new tVirtualCalender();
        FCalender.ExecuteCommand("memymd",date());
        FCalender.Left := 1;
        FCalender.top := 1;
        FCalender.host := self(true); 
    end 
    function paint();override;
    begin
        if FCalender then FCalender.paint();
    end 
    function MouseUp(o,e);override;
    begin
        inherited;
        if e.skip then return ;
        if not FCalender then return ;
        if e.button()= mbLeft then 
        begin 
            r := FCalender.ExecuteCommand("mestatebypos",e.pos); 
            if r then return ;
            r := FCalender.ExecuteCommand("megetincpos",e.pos);         
            if r then return  FCalender.ExecuteCommand("meminc",r); 
            std := FCalender.ExecuteCommand("mestate");
            r := FCalender.ExecuteCommand("meselbypos",e.pos);  
            if std=3 or  r="today" then 
            begin
                if FonSelect then 
                    CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
            end           
        end 
    end 
    function getCurrentSelection();begin
    {**
        @explan(说明)获取当前选择的日期，该函数仅能用于单选的月历控件%%
        @return(array/integer/nil)array:成功;0:失败;nil:未设置过此项。
        		    array(2019,2,1)    					
    **}
			     if FCalender then 
			     begin
			         r := FCalender.ExecuteCommand("meymd");
			         decodedate(r,y,m,d);
			         return array(y,m,d);
			     end 
			     return 0;   
    end
    function setCurrentSelection(y,m,d);
    begin
        {**
            @explan(说明)设置当前选择日期，该函数仅能用于单选的月历控件%%
            @param(y)(integer)年%%
            @param(m)(integer)月%%
            @param(d)(integer)日%%
            @return(integer)1:成功;0:失败;-1:出错%%
        **}
        if ifnumber(y) and ifnumber(m) or ifnumber(d) then 
        begin
            dt := encodedate(y,m,d);
            if FCalender then 
            begin
                FCalender.ExecuteCommand("meymd",dt);
                return 1;
            end     
        end 			
		  end
    function DoDatechanged();
    begin
        if FonSelectChange then 
            CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
    end 
    function recycling();override;
    begin
        FCalender.recycling();
        inherited;
        FCalender := nil;
        FonSelect := nil;
        FonSelectChange := nil;
    end 
    property onSelectChange read FonSelectChange write FonSelectChange;
    property TodayButton:bool read getnoTodayButton write setNoTodayButton;
    property onSelect:eventhandler read FonSelect write FonSelect;
    property onSelChanged:eventhandler read FonSelectChange write FonSelectChange;
    function publishs();override;
    begin
        return array("name","caption","anchors","enabled","color",
        "popupmenu","visible","parentcolor",
        "height","width","left","top","border","onmousemove","onpopupmenu",
        "onmousedown","onmouseup","onselchanged");
    end 
    {**
        @param(todayButton)(bool)月历显示“今日”按钮（默认开启）%%
        @param(onselchanged)(function[tmonthcalendar,tuieventbase])选择日期改变%%
    **}
    
    private 
    function setNoTodayButton(v);
    begin
        if FCalender then return FCalender.ExecuteCommand("metodaybutton",v);
    end 
    function getnoTodayButton();
    begin
        if FCalender then return FCalender.ExecuteCommand("metodaybutton");
    end 
    private 
    FCalender;
    FMousedownState;
    FonSelect;
    FonSelectChange;
end 

type tdatetimepicker = class(tthreeEntry)
{**
    @explan(说明) 日期选择控件 %%
**}
    function create(aowner);
    begin
        inherited;
        caption:="Date/TimePicker";
        FCalender := new tmonthcalendar(self);
        FCalender.border := true;
        FCalender.WsPopUp := true;
        FCalender.parent := self;
        FCalender.Visible := false;
        FScreenRect := _wapi.GetScreenRect();
        decodedate(date(),y,m,d);
        setDate(y,m,d);
        FCalender.onSelect := function(o,e)begin
            FCalender.Visible := false;
            d := FCalender.getCurrentSelection();
            setDate(d[0],d[1],d[2]);    
        end 
        FCalender.OnActivate := function(o,e)begin
            if e.wparam=0 then 
            begin
                FCalender.Visible := false;
            end 
        end 
    end
    function btnclicked(p);override;
    begin
        rec := BtnRect;
        if pointinrect(p,rec) then 
        begin 
            ShowDropDown(true);
            return true;
        end         
    end 

    function ExecuteCommand(cmd,p);override;
    begin
        case cmd of 
            "dtchanged":
            begin
                es := entrys;
                if p = es[2] then //日
                begin
                    pn := getenumber(p);
                    y := getenumber(es[0]);
                    m := getenumber(es[1]); 
                    if pn<1  then p.text := inttostr(getmonthdates(y,m));
                    else 
                    if pn>28 and pn>getmonthdates(y,m) then 
                    begin
                        p.text := "1";                    
                    end 
                end else 
                if p = es[1] then //月
                begin
                    y := getenumber(es[0]);
                    m := getenumber(es[1]);
                    bm := m;
                    if m>12 then 
                    begin
                        m := 1;
                    end else 
                    if m<1 then m := 12;
                    if bm<>m then 
                    begin
                        p.text := inttostr(m);
                    end 
                    d := getenumber(es[2]);   
                    if d<1 then es[2].text := "1";   
                    else 
                    if d>28 then 
                    begin                
                        ct := getmonthdates(y,m);
                        if d>ct then es[2].text := inttostr(ct);
                    end    
                end else 
                if p = es[0] then //年
                begin
                    y := getenumber(p);
                    m := getenumber(es[1]);
                    d := getenumber(es[2]);
                    if dt>28 then 
                    begin
                        ct := getmonthdates(y,m);
                        if d>ct then es[2].text := inttostr(ct);
                    end                     
                end  
                if Fonselectchange then 
                    calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));           
            end  
            "dtadate":
            begin
                es := entrys;
                if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[2]) then 
                begin                    
                    dt := encodedate(p[0],p[1],p[2]);
                    decodedate(dt,y,m,d);
                    es[0].text := inttostr(y);    
                    es[1].text := inttostr(m);    
                    es[2].text := inttostr(d); 
                    if Fonselectchange then   
                        calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));               
                end else 
                begin
                    y := strtointdef(es[0].text,2021);        
                    m := strtointdef(es[1].text,1);        
                    d := strtointdef(es[2].text,1);  
                    return array(y,m,d);      
                end 
            
            end                
        
        end 
    end 
    function ShowDropDown(f);virtual;
    begin
        {**
        @explan(说明) 设置弹出框的显示区域 %%
        **}
        if not(FCalender ) then return ;
        nv := ifnil(f)?true:(f?true:false);
        if FCalender.Visible = nv then return FCalender.show(0);
        rc := ClientRect;
        nrc := ClientToScreen(rc[0],rc[3]); 
        if FScreenRect[3]-nrc[1]<200 then 
        begin 
            nrc[1]:= nrc[0]-height-FCalender.height-2;    
        end 
        FCalender.Left := nrc[0];
        FCalender.top := nrc[1]; 
        dt := getDate();
        FCalender.setCurrentSelection(dt[0],dt[1],dt[2]);
        FCalender.show();          
    end 
    function getDate();
    begin
    {**
        @explan(说明) 获得日期 %%
        @return(array) array(y,m,d) %%
    **}
        return ExecuteCommand("dtadate");
    end 
    function setDate(y,m,d);
    begin   
    {**
        @explan(说明) 获得日期 %%
        @param(y)(integer) 年 %%
        @param(m)(integer) 月 %%
        @param(d)(integer) 日 %%
    **}     
        return  ExecuteCommand("dtadate",array(y,m,d));   
    end 
    function recycling();override;
    begin
        inherited;
        FCalender := nil;
        Fonselectchange := nil;
    end 
    function publishs();override;
    begin
        return array("name","caption","anchors","enabled","font","color",
        "popupmenu","visible","parentcolor","parentfont",
        "height","width","left","top","border","onmousemove","onpopupmenu",
        "onmousedown","onmouseup","onselchanged","onnotification");
    end  
    property onselectchange:eventhandler read Fonselectchange write Fonselectchange; 
    property onselchanged:eventhandler read Fonselectchange write Fonselectchange; 
    {
        @param(onselchanged)(function[tdatetimepicker,tuieventbase])选择日期改变%%
    }   
    private 
    function getenumber(e);
    begin
        t := e.text;
        ti := strtointdef(t,1);
        return ti;    
    end 
    FScreenRect;
    FCalender;
    Fonselectchange;
end 
type ttimepicker = class(tthreeEntry)
    function create(aowner);
    begin
        inherited;
        caption := "timepicker";
        width := 120;  
        ExecuteCommand("dttime",now());      
    end 
    function ExecuteCommand(cmd,p);override;
    begin
        case cmd of 
            "dttime":
            begin
                if ifnumber(p) then 
                begin 
                    decodedatetime(p,y,mt,d,h,m,s,ms);
                    ExecuteCommand("dtatime",array(h,m,s));
                    
                end else 
                begin
                    r := ExecuteCommand("dtatime"); 
                    r2 := encodedatetime(2021,1,1,r[0],r[1],r[2],0);
                    if ifarray(r) then 
                    begin
                        return frac(r2);
                    end        
                end 
            end 
            "dtatime":
            begin
                es := entrys; 
                if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[1]) then 
                begin                    
                    es[0].text := inttostr(p[0]);
                    es[1].text := inttostr(p[1]);
                    es[2].text := inttostr(p[2]);
                    ExecuteCommand("dtchanged",es[2]);
                end else 
                begin
                    r := array();
                    for i,v in es do r[i] := strtointdef(v.text,0);
                    return r;
                end 
            end 
            "dtchanged":
            begin
                es := entrys;
                if es[2]=p then 
                begin
                    t := p.text;
                    ti := strtointdef(t,0);  
                    if ti<0 then 
                    begin
                        p.text := "59";
                        es[1].dec();
                    end  else 
                    if ti>59 then 
                    begin
                        p.text := "0";
                        es[1].inc();
                    end 
                end else 
                if es[1] = p then 
                begin
                    t := p.text;
                    ti := strtointdef(t,0);  
                    if ti<0 then 
                    begin
                        p.text := "59";
                        es[0].dec();
                    end  else 
                    if ti>59 then 
                    begin
                        p.text := "0";
                        es[0].inc();
                    end 
                end else 
                if es[0] = p then 
                begin
                    t := p.text;
                    ti := strtointdef(t,0);  
                    if ti<0 then p.text := "24";
                    else if ti>24 then p.text := "0";
                end  
                if Fonselectchange then 
                    calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));                 
            end                         
        end 
    end 
    function PaintBtn();override;
    begin
        if FRectUp then 
        begin
            dc := Canvas;
            dc.Draw("framecontrol",array(FRectUp[0:1],FRectUp[2:3]),DFC_SCROLL,DFCS_SCROLLUP);
            dc.Draw("framecontrol",array(FRectDown[0:1],FRectDown[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN);
        end   
    end 
    function btnClicked(p);virtual;
    begin
        if pointinrect(p,FRectUp) then 
        begin
            for i,v in entrys do 
            begin
                if v.HasFocus then 
                begin
                    v.inc();
                    return 1;
                end 
            end 
            
        end  else 
        if  pointinrect(p,FRectDown) then 
        begin
            for i,v in entrys do 
            begin
                if v.HasFocus then 
                begin
                    v.dec();
                    return 1;
                end 
            end 
            
        end  
    end 
    function getTime();override;begin
    {**
        @explan(说明)获取控件当前选择的时间%%
        @return(array)%%
    **}
        return ExecuteCommand("dtatime");
    end
    function setTime(h,m,s);override;begin
        {**
            @explan(说明)设置控件当前选择的时间%%
            @param(h)(integer)时，24小时制%%
            @param(m)(integer)分%%
            @param(s)(integer)秒%%
        **}
        return ExecuteCommand("dtatime",array(h,m,s));
    end
    function recycling();override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","align","anchors","caption","enabled","font","color",
        "popupmenu","visible","parentcolor","parentfont",
        "height","width","left","top","border","onmousemove","onpopupmenu",
        "onmousedown","onmouseup","onkeyup","onkeydown","onselchanged","onnotification");
    end 
    property onselectchange read Fonselectchange write Fonselectchange;
    property onselchanged:eventhandler read Fonselectchange write Fonselectchange;
    {
        @param(onselchanged)(function[ttimepicker,tuieventbase])选择日期改变%%
    }   
    protected
    function calcCtls();override;
    begin
        inherited;
        rec := BtnRect;
        FRectUp := array(rec[0],rec[1],rec[2],integer(rec[1]+rec[3]/2));
        FRectDown := array(rec[0],integer(rec[1]+rec[3]/2),rec[2],rec[3]);
    end 
    private
    function getEntryWidth(i);virtual;
    begin
        return 2;     
    end 
    function getSym(i);virtual;
    begin
        return ":";
    end 
    FRectUp;
    FRectDown;
    Fonselectchange;
end 	
type tipaddr = class(tcustomipaddr)
	{**
		@explan(说明) ip控件 %%
	**}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","align","anchors","font","color","caption","visible","parentcolor","parentfont","height","width","left","top",
        "ipaddr","hasport","onaddrchanged","border","wsdlgmodalframe","onnotification");
    end
end 	

type TSpinEdit=class(TCustomSpinEdit)
    {**
    @explan(说明)spinedit控件
    **}
    function Create(AOwner);override;
    begin
        inherited;
        //border := true;
    end
    function publishs();override;
    begin
        return array("name","left","top","anchors","width","height",
            "border","enabled","visible",
            "increment","minvalue","maxvalue","value","wsdlgmodalframe","onincrease","ondecrease","onnotification");
    end
end

type tapplicationwindow=class(TWinControl)
    {**
    @explan(说明) application窗口类 %%
    **}
    function create(AOwner);override;
    begin
        //class(TWinControl).create(AOwner);
        inherited;
        caption := "applicationwindow";
        FLeft := 0;
        FTop := 0;
        FHeight := 0;
        Fwidth := 0;
        Visible := true;
        WsPopUp := true;
        WsCaption := true;
    end
    function createparams(p);override;
    begin
        inherited;
        p.WinClassName := "tsui_application";
        //p.style := p.style .& (.! (WS_GROUP .| WS_TABSTOP .| WS_CHILD));
        //p.exstyle := WS_EX_TOOLWINDOW;
        //p.style := WS_VISIBLE .|  WS_POPUP .| WS_CAPTION ;//.| WS_CLIPSIBLINGS .| WS_SYSMENU;
    end
    function InitializeWnd();override;
    begin
        inherited;
        {echo self.Handle;
        SysMeu := _wapi.GetSystemMenu(self.Handle,False);
        echo "\r\nsysmenu",sysmenu;
        echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_MAXIMIZE,MF_BYCOMMAND);
        echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_SIZE,MF_BYCOMMAND);
        echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_MOVE,MF_BYCOMMAND);
        echo "\r\nsysmenu",sysmenu;}
    end
    Function DoWMCLOSE(o,e);override;
    begin
        Recycling();
        _wapi.PostQuitMessage(0);
    end
    function DoCnNotify(o,e);override;
    begin
    end
end

type TImageListDrawStyle = class()
    {**
    	@explan(说明) imagelist 绘制的样式选择 %%
    **}
    static ILD_NORMAL;static ILD_TRANSPARENT;
    static ILD_MASK;static ILD_IMAGE;static ILD_ROP;
    static ILD_BLEND25;static ILD_BLEND50;static ILD_OVERLAYMASK;
    static ILD_PRESERVEALPHA;static ILD_SCALE;static ILD_DPISCALE;
    static ILD_ASYNC;static ILD_SELECTED;static ILD_FOCUS;
    static ILD_BLEND;
end 
type TImageListCreateflags = class()
    {**
    @explan(说明) imagelist 构造的参数 %%;
    **}
    static ILC_MASK;static ILC_COLOR;static ILC_COLORDDB;
    static ILC_COLOR4;static ILC_COLOR8;static ILC_COLOR16;
    static ILC_COLOR24;static ILC_COLOR32;static ILC_PALETTE;
    static ILC_MIRROR;static ILC_PERITEMMIRROR;static ILC_ORIGINALSIZE;
    static ILC_HIGHQUALITYSCALE;

end 

type tcontrolimagelist=class(tcustomcontrolimagelist)
    {**
    @explan(说明) 控件imagleit %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
end 


type TDragImageList=class(TCustomImageList)
    {**
    @ignore(忽略) %%
    **}
    private
    FDragCursor:TCursor;
    FDragging:Boolean;
    FDragHotspot:TPoint;
    FOldCursor:TCursor;
    FImageIndex:Integer;
    FLastDragPos:TPoint;
    FLockedWindow:HWND; // window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)
    procedure SetDragCursor(AValue);
    begin
        if ifnumber(AValue)and FDragCursor.id <> AValue then
        begin
            FDragCursor.id := AValue;
        end
    end
    protected
    procedure Initialize;override;
    public
    function create(Owner);override;
    begin
        inherited;
        FDragCursor := new TCursor();
    end
    function BeginDrag(Window:HWND;X,Y:Integer):Boolean;
    begin
        if not HandleAllocated()then exit;
        if not FDragging then
        begin
            FDragCursor.show();
            FDragging := true;
            DragLock(Window,x,y);
            FDragHotspot := array(x,y);
            px := integer(Width/2);
            py := integer(Height/2);
            _wapi.ImageList_BeginDrag(self.Handle,FImageIndex>0?FImageIndex:0,px,py);
            _wapi.ImageList_DragEnter(Window,x,y);
        end else
        DragMove(x,y);
    end
    function DragLock(Window:HWND;XPos,YPos:Integer):Boolean;
    begin
        FLockedWindow := HWND;
    end
    function DragMove(X,Y:Integer):Boolean;
    begin
        if FDragging then
        begin
            _wapi.ImageList_DragMove(x,y);
        end
    end
    procedure DragUnlock;
    function EndDrag:
    Boolean;
    begin
        if FDragging then
        begin
            _wapi.ImageList_DragLeave(FLockedWindow);
            _wapi.ImageList_EndDrag();
            FDragging := false;
        end
    end
    function GetHotSpot:
    TPoint;
    override;
    begin
        return FDragHotspot;
    end
    procedure HideDragImage;
    function SetDragImage(Index,HotSpotX,HotSpotY:Integer):Boolean;
    //procedure ShowDragImage;
    property DragCursor:TCursor read FDragCursor write SetDragCursor;
    property DragHotspot:TPoint read FDragHotspot write FDragHotspot;
    property Dragging:Boolean read FDragging;
    property ImageIndex read FImageIndex write FImageIndex;
end
type TImage = class(tcustomimage)
    function create();
    begin
        inherited;
    end 
end
type TBitmap = class(tcustombitmap)

    function create();override;
    begin
        inherited;
    end 
end 
type TIcon = class(tcustomicon)
    function create();override;
    begin
        inherited;
    end 
    
end 
type tcursor = class(tcustomcursor)
    function create();override;
    begin
        inherited;
    end 
end 	

type TFont = class(tcustomfont)
    function create();override;
    begin
        inherited;
    end
end 

type tpen = class(tcustompen)
    function create();override;
    begin
        inherited;
    end 

end 

type TBrush = class(tcustombrush)
    function create();override;
    begin
        inherited;
    end 
end 
type TCanvas = class(TCustomcanvas)
    function create();override;
    begin
        inherited;
    end 
end 
type TTimer = class(TCustomTimer)
    {**
    @explan(说明)定时器类,间隔是以毫秒为最小单位 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","interval","ontimer","onnotification");
    end
end 

//******action 相关*****************************************


type TAction=class(TCustomAction)
    {**
    @explan(说明) action / command 类 对外接口,参考 TCustomAction 类 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
    
    function publishs();override;
    begin
        r := array("name","caption","enabled","shortcut","onexecute","onnotification");
        return r;
    end
end
type tactionlist =class(TCustomactionlist)
    function create(AOwner);override;
    begin
        inherited;
    end
    function publishs();override;
    begin
        return array("name","onnotification");
    end
end 


//*****************************
type TMessageboxADlg = class(TcustommsgADlg)
    {**
    @explan(说明) 消息提示框 %% 
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","chooseok","caption",
            "mbtext","mbbtnstyle","mbiconstyle","onnotification");
    end
end 
type TColorChooseADlg = class(tcustomcolordlg)
    {**
    @explan(说明)颜色选择器 %% 
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","chooseok","caption",
            "customcolors","result","onnotification");
    end
end 
type TFontChooseADlg = class(tcustomfontdlg)
    {**
    @explan(说明) 字体选择对话框 %%
    **}
    function Create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        array("name","chooseok","caption","color","onnotification");
    end

end 
type TSavefileADlg = class(tcustomfsdlg)
    {**
    @explan(说明) 保存文件,获得文件名 %%
    @param(FFileTag)(TtagOFNA)openfile 对象 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","caption","filter","filterindex","filename","defaultfileextension",
            "showhidden","multiselected","overwriteprompt","filemustexist","onnotification"); //"linkfilepath" "createprompt"
    end

end 
type TOpenFileADlg=class(tcustomfsdlg)
    {**
    @explan(说明) 打开文件对话框类 %%
    **}
    private
    function OpenFileDlg();virtual;
    begin
        r := _wapi.GetOpenFileNameA(FFileTag._getptr_);
        return r;
    end
    protected
    function dlgType();virtual;
    begin
        return 2;
    end
    public
    function create(AOwner);override;
    begin
        inherited;
    end
    function publishs();override;
    begin
        return array("name","caption","filter","filterindex","filename",
            "defaultfileextension","showhidden","multiselected","onnotification"); //,"linkfilepath"
    end
end
type TFolderChooseADlg = class(tcustomfolderdlg)
    {**
    @explan(说明) 文件夹路径选择对话框 %%
    **}
    function create(AOwner);
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","caption",
            "defaultdir","rootfolder","folder","onnotification");
    end
end 

	//菜单
type TMenu = class(TcustomMenu)
    {**
    @explan(说明) 菜单 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
    function publishs();override;
    begin
        return array("action","bitmap","caption","checked","enabled","name","tseparator",
            "onclick","onrbuttonup","onselect","onnotification");
    end
end 
type TPopupmenu=class(TcustomPopupmenu)
    {**
    @explan(说明) 弹出菜单 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
    function publishs();override;
    begin
        return array("name","caption","enabled","onrbuttonup","onnotification");
    end
end
type TMainmenu = class(TcustomMainmenu)
    {**
    @explan(说明) 主窗口菜单 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end
    function publishs();override;
    begin
        return array("name");
    end
end 

type TApplicationProperties=class(TComponent)
    {**
	
    @ignore(忽略) %%
    @explan(说明)应用属性设置 %%
    **}
    private
    FApplication;
    FTrayData;
    function SetShowTray();
    begin
    end
    function SetPopupMenu();
    begin
    end
    public
    function Create(AOwner);
    begin
        inherited;
        FApplication := getapplication();
        FTrayData := new TNOTIFYICONDATAA();
    end
    property TrayMenu:tpopupmenu read FPopupMenu write SetPopupMenu;
    property TrayIcon:icondata read FTrayIcon write FTrayIcon;
    property ShowTray:bool read FShowTray write SetShowTray;
end

type TClipBoard = class(TcustomClipBoard)
    {**
    @explan(说明) 剪切板类 %%
    **}
    function create(AOwner);override;
    begin
        inherited;
    end 
    function publishs();override;
    begin
        return array("name","text","bmp");
    end
end 

	//线程
type TThreadWorker  =class(TCustomThreadworker)
    {**
        @explan(说明) 工作线程 %%
    **}
    uses uvclthreadworker;
    function create(s,libs,declaration);
    begin
        inherited;
    end 
    protected
    function Check_TslCode(FScript,err);override;
    begin
        return CheckTslCode(FScript,err);
    end 	
end 	
	//注册表操作类
type TRegKey = class
    {**
        @explan(说明) windows注册表操作类 %%
    **}
    static HKEY_CLASSES_ROOT;
    static HKEY_CURRENT_USER;
    static HKEY_LOCAL_MACHINE;
    static HKEY_USERS;
    static HKEY_PERFORMANCE_DATA;
    static HKEY_PERFORMANCE_TEXT;
    static HKEY_PERFORMANCE_NLSTEXT;
    {$ifdef linux}
    class function RegEnumValueA(hKey:pointer;dwIndex:integer;var lpValueName:string;var lpcchValueName:integer;lpReserved:pointer;lpType:pointer;lpData:pointer;lpcbData:pointer):integer;
    class function RegEnumKeyA(hKey:pointer;dwindex:integer;var lpName:string;ccname:integer):integer;
    class function RegQueryValueExA(hKey:pointer;lpValueName:string;lpReserved:integer;var lpType:integer;var lpData:string;var lpcbData:integer):integer;
    class function RegSetValueExA(hkey:pointer;keyValueName:string;lpReserved:integer;lpType:integer;data:string;len:integer):integer;
    class function RegOpenKeyA(Key:pointer;lpSubKey:string;var phkResult:pointer):integer;
    class function RegCloseKey(hKey:pointer):integer;
    class function RegOpenKeyExA(Key:pointer;lpSubKey:string;rs:integer;ac:integer;var phkResult:pointer):integer;
    class function RegCreateKeyExA(hKey:pointer;lpSubKey:string;Reserved:integer;lpClass:string;dwOptions:integer;samDesired:integer;lpSecurityAttributes:pointer;var phkResult:pointer;var lpdwDisposition:integer):integer;
    class function RegDeleteKeyExA(hKey:pointer;lpSubKey:string;samDesired:integer;Reserved:integer):integer;
    class function RegDeleteKeyA(hKey:pointer;lpSubKey:string):integer;
    class function RegDeleteValueA(hKey:pointer;lpValueName:string):integer;
    class function RegDeleteKeyValueA(hKey:pointer;lpSubKey:string;lpValueName:string):integer;
    class function RegDeleteTreeA(hKey:pointer;lpSubKey:string):integer;
    class function FormatMessageA(dwFlags:integer;lpSource:pointer;dwMessageId:integer;dwLanguageId:integer;var pBuffer:string;nSize:integer;):integer;
    {$else}
    class function RegEnumValueA(hKey:pointer;dwIndex:integer;var lpValueName:string;var lpcchValueName:integer;lpReserved:pointer;lpType:pointer;lpData:pointer;lpcbData:pointer):integer;stdcall;external "Advapi32.dll" name "RegEnumValueA";
    class function RegEnumKeyA(hKey:pointer;dwindex:integer;var lpName:string;ccname:integer):integer;stdcall;external "Advapi32.dll" name "RegEnumKeyA";
    class function RegQueryValueExA(hKey:pointer;lpValueName:string;lpReserved:integer;var lpType:integer;var lpData:string;var lpcbData:integer):integer;stdcall;external "Advapi32.dll" name "RegQueryValueExA";
    class function RegSetValueExA(hkey:pointer;keyValueName:string;lpReserved:integer;lpType:integer;data:string;len:integer):integer;stdcall;external "Advapi32.dll" name "RegSetValueExA";
    class function RegOpenKeyA(Key:pointer;lpSubKey:string;var phkResult:pointer):integer;stdcall;external "Advapi32.dll" name "RegOpenKeyA";
    class function RegCloseKey(hKey:pointer):integer;stdcall;external "Advapi32.dll" name "RegCloseKey";
    class function RegOpenKeyExA(Key:pointer;lpSubKey:string;rs:integer;ac:integer;var phkResult:pointer):integer;stdcall;external "Advapi32.dll" name "RegOpenKeyExA";
    class function RegCreateKeyExA(hKey:pointer;lpSubKey:string;Reserved:integer;lpClass:string;dwOptions:integer;samDesired:integer;lpSecurityAttributes:pointer;var phkResult:pointer;var lpdwDisposition:integer):integer;stdcall;external "Advapi32.dll" name "RegCreateKeyExA";
    class function RegDeleteKeyExA(hKey:pointer;lpSubKey:string;samDesired:integer;Reserved:integer):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyExA";
    class function RegDeleteKeyA(hKey:pointer;lpSubKey:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyA";
    class function RegDeleteValueA(hKey:pointer;lpValueName:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteValueA";
    class function RegDeleteKeyValueA(hKey:pointer;lpSubKey:string;lpValueName:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyValueA";
    class function RegDeleteTreeA(hKey:pointer;lpSubKey:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteTreeA";
    class function FormatMessageA(dwFlags:integer;lpSource:pointer;dwMessageId:integer;dwLanguageId:integer;var pBuffer:string;nSize:integer;):integer;stdcall;external "Kernel32.dll" name "FormatMessageA";
    {$endif}
    class function GetRegKeyRoot();
    begin
        {**
        @explan(说明) 获得HKEY_CLASSES_ROOT的key %%
        @return(TRegKey|integer) 如果成功返回 key 对象 %%
        **}
        sinit();
        return new TRegKey(HKEY_CLASSES_ROOT);
    end
    class function GetRegKeyUser();
    begin
        {**
        @explan(说明) 获得HKEY_CURRENT_USER的key %%
        @return(TRegKey|integer) 如果成功返回 key 对象 %%
        **}
        sinit();
        return new TRegKey(HKEY_CURRENT_USER);
    end
    class function GetRegKeyMachine();
    begin
        {**
        @explan(说明) 获得HKEY_LOCAL_MACHINE的key %%
        @return(TRegKey|integer) 如果成功返回 key 对象 %%
        **}
        sinit();
        return new TRegKey(HKEY_LOCAL_MACHINE);
    end
    class function GetEnviromentKey();
    begin
        {**
        @explan(说明) 获得环境变量的key %%
        @return(TRegKey|integer) 如果成功返回 key 对象 %%
        **}
        sinit();
        k1 := new TRegKey(HKEY_LOCAL_MACHINE);
        return k1.openKeyA("SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment");
    end
    class function EnvironmentPath(k2);
    begin
        {**
        @explan(说明) 获得环境路径的所有值%%
        @return(array of string) 环境路径数组 %%
        **}
        if ifnil(k2)then k2 := GetEnviromentKey();
        if not ifobj(k2)then return nil;
        r := str2array(k2.GetValueA("path"),";");
        rt := array();
        for i,v in r do
        begin
            vi := trim(v);
            if vi then rt[length(rt)]:= lowercase(vi);
        end
        return rt;
    end
    private
    FHandle;
    FResult;
    function CloseRegKey();
    begin
        if ifnumber(FHandle)and not(FHandle in array(HKEY_CLASSES_ROOT,HKEY_CURRENT_USER,HKEY_LOCAL_MACHINE,HKEY_USERS,HKEY_PERFORMANCE_DATA,HKEY_PERFORMANCE_TEXT,HKEY_PERFORMANCE_NLSTEXT))then 
            RegCloseKey(FHandle);
    end
    function SetHandle(h);
    begin
        if h <> FHandle then
        begin
            CloseRegKey();
            FHandle := h;
        end
    end
    public
    function create(h);
    begin
        if not HKEY_CLASSES_ROOT then sinit();
        SetHandle(h);
    end
    function Destroy();
    begin
        CloseRegKey();
    end
    function openKeyA(vn);
    begin
        {**
        @explan(说明) 打开或者新建 key%%
        @param(vn)(string) value 名字 %%
        @return(TRegKey) 值 %%
        **}
        if not FHandle then return-1;
        if not(ifstring(vn)and vn)then return-1;
        h2 := 0;
        rr := RegOpenKeyExA(FHandle,vn,0,0xF003F,h2);
        if 0=rr then
        begin
            r := new TRegKey(h2);
            return r;
        end
        state := 0;
        hk2 := 0;
        rr := RegCreateKeyExA(FHandle,vn,0,"",0,0,0,hk2,state);
        if rr=0 then
        begin
            r := openKeyA(vn); //new TRegKey(hk2);
            return r;
        end
        return rr;
    end
    function GetValueA(vn,vt);
    begin
        {**
        @explan(说明) 获得value值%%
        @param(vn)(string) value 名字 %%
        @param(vt)(integer) 类型 %%
        @return(string) 值 %%
        **}
        if not FHandle then return-1;
        if not(ifstring(vn)or ifnil(vn))then return-1;
        if not ifnumber(vt)then vt := 0;
        d := "";
        setlength(d,2064);
        len := 2063;
        rr := RegQueryValueExA(FHandle,vn,0,vt,d,len);
        if 0=rr then
        begin
            return d[1:len-1];
        end
        return rr;
    end
    function SetValueStringA(vn,v);
    begin
        {**
        @explan(说明) 设置value值%%
        @param(vn)(string) value 名字,nil为默认值%%
        @param(v)(string) 值 %%
        **}
        if not FHandle then return-1;
        if not(ifstring(vn)or ifnil(vn))then return-1;
        rs := 0;
        tp := 1;
        return RegSetValueExA(FHandle,vn,rs,tp,v,length(v));
    end

    function DeleteValueA(vn);
    begin
        {**
        @explan(说明) 删除value %%
        @param(vn)(string) value 名字 %%
        **}
        if not FHandle then return -1;
        if not(ifstring(vn))then return -1;
        return RegDeleteValueA(FHandle,vn);
    end
    function DeleteKeyA(vn);
    begin
        {**
        @explan(说明) key %%
        @param(vn)(string) key %%
        **}
        if not FHandle then return-1;
        if not(ifstring(vn))then return-1;
        return RegDeleteKeyExA(FHandle,vn,0x0100,0);
    end
    function DeleteTreeA(vn);
    begin
        {**
        @explan(说明) 删除目录 %%
        @param(vn)(string) 目录名 %%
        **}
        if not FHandle then return-1;
        if not(ifstring(vn))then return-1;
        return RegDeleteTreeA(FHandle,vn);
    end
    function GetValueNames();
    begin
        {**
        @explan(说明) 获得value的名称 %%
        @return(array of string) 所有名称 %%
        **}
        r := array();
        if FHandle then
        begin
            s := "";
            ls := 1024;
            setlength(s,1024);
            idx := 0;
            while true do
            begin
                ls := 1024;
                sc := RegEnumValueA(FHandle,idx,s,ls,0,0,0,0);
                if sc=0 then
                begin
                    r[idx]:= s[1:ls];
                    idx++;
                end else
                break;
            end
        end
        return r;
    end
    function GetSubKeyNames();
    begin
        {**
        @explan(说明) 获得子项的名称 %%
        @return(array of string) 所有名称 %%
        **}
        r := array();
        if FHandle then
        begin
            s := "";
            ls := 1024;
            setlength(s,1024);
            idx := 0;
            while true do
            begin
                sc := RegEnumKeyA(FHandle,idx,s,ls);
                if sc=0 then
                begin
                    for i := 1 to 1024 do
                    begin
                        if s[i]="\0" then
                        begin
                            r[idx]:= s[1:(i-1)];
                            break;
                        end
                    end
                    idx++;
                end else
                break;
            end
        end
        return r;
    end
    class function sinit();override;
    begin
        {**
        @explan(说明) 初始化 %%
        **}
        if not HKEY_CLASSES_ROOT then
        begin
            HKEY_CLASSES_ROOT := 0x80000000;
            HKEY_CURRENT_USER := 0x80000001;
            HKEY_LOCAL_MACHINE := 0x80000002;
            HKEY_USERS := 0x80000003;
            HKEY_PERFORMANCE_DATA := 0x80000004;
            HKEY_PERFORMANCE_TEXT := 0x80000050;
            HKEY_PERFORMANCE_NLSTEXT := 0x80000060;
        end
        inherited;
    end
    property Handle read FHandle write SetHandle;
    {**
    @param(Handle)(pointer) regkey句柄 %%
    **}
end
type TWinEnviroment=class()
    {**
    @explan(说明) windows环境变量操作 %%
    **}
    function Create();
    begin
        FRegkey := class(TRegKey).GetEnviromentKey();
        if not(ifobj(FRegkey))then raise "非管理员不能操作环境变量!";
    end
    function GetPaths();
    begin
        {**
        @explan(说明) 获得环境路径 %%
        @return(array of string) 路径 %%
        **}
        PathInPaths("===",r);
        return r;
    end
    function AppendPath(p);
    begin
        {**
        @explan(说明) 追加环境路径 %%
        @param(p)(string) 路径 %%
        @return(bool) true 成功 false 失败 %%
        **}
        if not(PathOk(p))then return false;
        if not PathInPaths(p,paths)then
        begin
            return 0=FRegkey.SetValueStringA("path",array2str(paths,";")+";"+p);
        end
    end
    function RemovePath(p);
    begin
        {**
        @explan(说明) 移除环境路径 %%
        @param(p)(string) 路径 %%
        @return(bool)true 成功 false 失败 %%
        **}
        if not PathOk(p)then return false;
        if PathInPaths(p,paths)then
        begin
            return 0=FRegkey.SetValueStringA("path",array2str(paths,";"));
        end
    end
    private
    function PathOk(p);
    begin
        if not(ifstring(p)and p)then return false;
        for i,v in array(";","?",'"',"|","*") do
        begin
            if pos(v,p)then return false;
        end
        return true;
    end
    function PathInPaths(p,paths);
    begin
        pv := lowercase(RegularPath(p));
        if not pv then return 0;
        d := FRegkey.GetValueA("path");
        nothavepath := false;
        paths := array();
        LP := 0;
        for i,v in str2array(d,";") do
        begin
            vi := RegularPath(v);
            if not vi then continue;
            if lowercase(vi)=pv then
            begin
                nothavepath := true;
                continue;
            end
            paths[LP++]:= v;
        end
        return nothavepath;
    end
    function RegularPath(p);
    begin
        {**
        @explan(说明) 规则化数据 %%
        **}
        r := "";
        if p and ifstring(p)then
        begin
            r := trim(p);
            len := length(r);
            if r[len]="\\" and len>1 then return r[1:(len-1)];
        end
        return r;
    end
    FRegkey;
end

type TQuotations=class(tcomponent)
    {**
    @explan(说明) 行情订阅以及远程执行类 %%	
    **}
    private
    static FSQuotations;
    static RE_ERROR;
    static RE_FUNCRESULT;
    static RE_FUNCSTATE;
    static RE_ECHO;
    static RE_QUERY;
    FOncallBack; //回调函数
    FChannel; //通道
    FData; //返回数据
    FIds;
    FSUbs;
    FScript;
    FGlobalVariable;
    function EndRemoteExecute();
    begin
        if FChannel then
        begin
            EndExecute(FChannel);
            reindex(FSQuotations,array(FChannel:nil));
            FChannel := 0;
            FData := array();
        end
    end
    protected
    class function sinit();override;
    begin
        inherited;
        if not ifarray(FSQuotations)then
        begin
            FSQuotations := array();
            RE_ERROR := 0;
            RE_FUNCRESULT := 0x0201;
            RE_FUNCSTATE := 0x0301;
            RE_ECHO := 0x0401;
            RE_QUERY := 0x0402;
        end
    end
    function RemoteCallBack(d);virtual;
    begin
        {**
        @explan(说明) 回调执行 %%
        **}
        if not ifarray(d)then exit;
        FData := d;
        calldatafunction(FOncallBack,self(true));
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        FData := array();
        FIds := array();
        FGlobalVariable := array();
        FSUbs := array();
        FScript := "";
    end
    function RemoteExecute();
    begin
        {**
        @explan(说明) 远程执行代码 %%
        @return(integer) channel  %%
        **}
        if not ifstring(FScript)then return 0;
        if not ifarray(FGlobalVariable)then sysp := array();
        else sysp := FGlobalVariable;
        EndRemoteExecute();
        FChannel := SendExecute(FScript,sysp,"return unit(tslvcl).remotetslcallback(sysparams);",1);
        if not FChannel then return 0;
        FSQuotations[FChannel]:= self(true);
        return FChannel;
    end
    function MarketSubscription();
    begin
        {**
        @explan(说明) 构造行情订阅  %%
        @return(integer) channel  %%
        **}
        EndRemoteExecute();
        if not(FIds and ifarray(FIds)and FSUbs and ifarray(FSUbs))then
        begin
            return 0;
        end
        qts := array("Type":1);
        qts["IDs"]:= FIds;
        qts["SUBs"]:= FSUbs;
        FChannel := SendExecute("",qts,"return unit(tslvcl).remotetslcallback(sysparams);",0);
        if not FChannel then return 0;
        FSQuotations[FChannel]:= self(true);
        return FChannel;
    end
    function Recycling();override;
    begin
        EndRemoteExecute();
        FOncallBack := nil;
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    class function Dispatch(dt);
    begin
        {**
        @explan(说明) 消息分发 %%
        **}
        if ifarray(dt)then
        begin
            //              0:错误通知
            //         0x0201:执行函数返回
            //         0x0301:提交委托函数的状态返回
            //         0x0401:Echo
            //         0x0402:RunningData返回/订阅行情的结果集	
            o := FSQuotations[dt["channel"]];
            if ifobj(o)then o.RemoteCallBack(dt);
        end
    end
    function echodata();
    begin
        {**
        @explan(说明) 获取echo 的信息 %%
        @return(string|nil) 非echo 类型返回nil%%
        **}
        if FData["recvtype"]=RE_ECHO then
        begin
            return FData["errmsg"];
        end
        return nil;
    end
    function errormessage();
    begin
        {**
        @explan(说明) 获取错误的信息 %%
        @return(string|nil) 无错误返回nil%%
        **}
        if FData["recvtype"]=RE_ERROR then
        begin
            return FData["errmsg"];
        end
        return nil;
    end
    function result();
    begin
        {**
        @explan(说明) 获取执行结果 %%
        **}
        if FData["recvtype"]in array(RE_FUNCRESULT,RE_QUERY)then
        begin
            return FData["result"];
        end
        return nil;
    end
    property OnCallBack:eventhandler read FOncallBack write FOncallBack;
    property Ids:strings read FIds write FIds;
    property SUBs:strings read FSUbs write FSUbs;
    property GlobalVariable:tsldata read FGlobalVariable write FGlobalVariable;
    property Script:text read FScript write FScript;
    function publishs();override;
    begin
        return array("name","ids","subs","globalvariable","script","oncallback","onnotification");
    end
    {**
    @param(OnCallBack)(function[TQuotations]) 执行回调 %%
    @param(ids)(array of stockid) 证券代码数组 array("SZ000001","SZ000002") %%
    @param(SUBs)(array of string) 订阅字段数组 array("StockName", "date","price", "open")  %%
    **}
end

type tlogincontrol=class(tpanel)
    {**
    @explan(说明) 登陆控件 %%
    **}
    private
    FserverEdit;
    FserverLabel;
    FuserLabel;
    FpwdLabel;
    Fstatus;
    FportEdit;
    FpwdEdit;
    FlogoutBtn;
    FloginBtn;
    FuserEdit;
    FCacheFile;
    FOnLogined;
    function LoadCacheData(); //导出缓存 
    begin
        importfile(ftStream(),"",FCacheFile,configinfos);
        if ifarray(configinfos)then
        begin
            FserverEdit.text := configinfos["server"];
            FportEdit.text := configinfos["port"];
            FuserEdit.text := configinfos["user"];
            FpwdEdit.text := configinfos["pwd"];
        end
    end
    function SaveCacheData() //保存缓存    
    begin
        exportfile(ftStream(),"",FCacheFile,array("server":FserverEdit.text,"port":FportEdit.text,"user":FuserEdit.text,"pwd":FpwdEdit.text));
    end
    function closelogin(); //关闭登陆窗口
    begin
        SaveCacheData();
        if Parent then EndModal();
        else show(0);
    end
    function setsatus(s);
    begin
        if ifstring(s)then Fstatus.setitemtext(s,1);
    end
    function clklogin(o,e);
    begin
        clklogin2(o,e);
        CallMessgeFunction(FOnLogined,self,e);
    end
    function clklogin2(o,e); //登陆按钮
    begin
        //登陆 设置状态  
        //参考 函数  LoginTslServer 
        setsatus("正在登陆...");
        logintext := FuserEdit.text;
        loginpwd := FpwdEdit.text;
        loginserve := FserverEdit.text+":"+FportEdit.text;
        if(CheckConnected()or(ConnectServer(FserverEdit.text,StrToFloatDef(FportEdit.text,443))=0))then
        begin
            msg := "";
            setlength(msg,200);
            if(CheckLogined()or LoginServer(logintext,loginpwd,msg)=0)then
            begin
                setsatus("登陆成功");
                FloginBtn.enabled := false;
                FlogoutBtn.enabled := true;
                hidenwindow();
                return 0;
            end else
            begin
                setsatus("登陆失败");
                messageboxA(msg,"登陆失败",1);
                return 1;
            end
        end else
        begin
            setsatus("连接服务器失败");
            messageboxA("连接服务器失败","提示",1);
            return 2;
        end
        return-1;
    end
    function clklogout(o,e); //退出登陆按钮
    begin
        //退出登陆设置状态 
        setsatus("与服务器断开连接");
        FloginBtn.enabled := true;
        FlogoutBtn.enabled := false;
        DisconnectServer();
    end
    function hidenwindow(o,e); //关闭按钮 
    begin
        //e.skip := true;
        closelogin();
    end
    function GetUsrName();
    begin
        return FuserEdit.text;
    end
    function SetUsrName(v);
    begin
        FuserEdit.text := v;
    end
    function GetPort();
    begin
        return FportEdit.text;
    end
    function SetPort(v);
    begin
        FportEdit.text := v;
    end
    function SetIp(v);
    begin
        FserverEdit.text := v;
    end
    function GetIp();
    begin
        return FserverEdit.text;
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        visible := false;
        FCacheFile := temppath()+ioFileseparator()+"loginer.stm";
        self.caption := "TinySoftLogin";
        rc := _wapi.GetScreenRect();
        self.height := 306;
        self.left :=(rc[2]-rc[0])/2-350;
        self.top :=(rc[3]-rc[1])/2-210;
        self.width := 428;
        self.wscaption := true;
        self.wspopup := true;
        self.wssizebox := true;
        self.wssysmenu := true;
        FserverEdit := new tedit(self);
        FserverEdit.parent := self;
        FserverEdit.height := 25;
        FserverEdit.left := 106;
        FserverEdit.text := "tsl.tinysoft.com.cn";
        FserverEdit.top := 26;
        FserverEdit.width := 179;
        FserverLabel := new tlabel(self);
        FserverLabel.parent := self;
        FserverLabel.left := 22;
        FserverLabel.top := 23;
        FserverLabel.width := 60;
        FserverLabel.height := 25;
        FserverLabel.caption := "服务器";
        FuserLabel := new tlabel(self);
        FuserLabel.parent := self;
        FuserLabel.left := 22;
        FuserLabel.top := 68;
        FuserLabel.width := 59;
        FuserLabel.height := 25;
        FuserLabel.caption := "用户名";
        FpwdLabel := new tlabel(self);
        FpwdLabel.parent := self;
        FpwdLabel.caption := "密码";
        FpwdLabel.left := 21;
        FpwdLabel.top := 112;
        FpwdLabel.width := 57;
        FpwdLabel.height := 25;
        Fstatus := new tstatusbar(self);
        Fstatus.parent := self;
        Fstatus.left := 0;
        Fstatus.top := 244;
        Fstatus.Items := array(("text":"状态","width":40),("text":"","width":200));
        FportEdit := new tedit(self);
        FportEdit.parent := self;
        FportEdit.height := 25;
        FportEdit.left := 298;
        FportEdit.text := "443";
        FportEdit.top := 25;
        FportEdit.width := 80;
        FlogoutBtn := new tbtn(self);
        FlogoutBtn.parent := self;
        FlogoutBtn.caption := "退出";
        FlogoutBtn.height := 31;
        FlogoutBtn.left := 80;
        FlogoutBtn.top := 173;
        FlogoutBtn.width := 94;
        FloginBtn := new tbtn(self);
        FloginBtn.parent := self;
        FloginBtn.caption := "登陆";
        FloginBtn.height := 31;
        FloginBtn.left := 226;
        FloginBtn.top := 173;
        FloginBtn.width := 94;
        FuserEdit := new tedit(self);
        FuserEdit.parent := self;
        FuserEdit.height := 25;
        FuserEdit.left := 107;
        FuserEdit.top := 68;
        FuserEdit.width := 177;
        FpwdEdit := new tpassword(self);
        FpwdEdit.parent := self;
        FpwdEdit.height := 25;
        FpwdEdit.left := 107;
        FpwdEdit.top := 114;
        FpwdEdit.width := 174;
        FloginBtn.onclick := thisfunction(clklogin);
        FlogoutBtn.onclick := thisfunction(clklogout);
        self.onclose := thisfunction(hidenwindow);
        FlogoutBtn.enabled := false;
    end
    function openlogin() //打开登录窗口
    begin
        LoadCacheData();
        if getloginstatus()then
        begin
            setsatus("登陆成功");
        end else
        setsatus("未登录");
        if Parent then ShowModal();
        else show();
    end
    function getloginstatus(); //获得状态
    begin
        {**
        @explan(说明) 获得登陆状态 %%
        @return(bool) true 已经登陆 false 未登陆
        **}
        if CheckLogined()then return true;
        else return false;
    end
    function publishs();override;
    begin
        return lowercase(array("name","port","ip","usrname","onlogined","onnotification"));
    end
    property Port:string read GetPort write SetPort;
    property Ip:string read GetIp write SetIp;
    property UsrName:string read GetUsrName write SetUsrName;
    property OnLogined:eventhandler read FOnLogined write FOnLogined;
    {**
    @param(port)(string) 端口号%%
    @param(ip)(string) 天软服务器 %%
    @param(UsrName)(string) 天软用户名 %%
    @param(OnLogined)(function[tlogincontrol,tuieventbase]) 登陆回调 %%
    **}
end


type TIniFileExta=class(TIniFileExter)
    {**
    @explan(说明) ini文件读写封装 %%
    **}   
    function create(al,Fname);
    begin
        {**
        @explan(说明) 构造函数 %%
        @param(al)(string) 别名 %%
        @param(name)(string) 文件名 %%
        **}
        inherited create();
        filename := fname;
        Alias := al;
    end  
end

type TCreateProcessA = class()
    {**
    @explan(说明) 进程构造对象 %%
    **}
    private
    FOnEcho;
    FBufSize;
    {$ifdef linux}
    static FProcesswnd;
    function parserasexeclevparam(exe,cmd,e,arg,envp);
    begin
        arg := ParserCommandLine(exe+" "+cmd);  
        if not arg then return 0;
        e := arg[0];
        for i := length(e) downto 2 do 
        begin
            if e[i]="/" then 
            begin
                ph  := e[1:i];
                break;
            end 
        end 
        arg[length(arg)] := nil;
        envp := array();
        if ph then 
        begin 
            envp[length(envp)] := "LD_LIBRARY_PATH=LD_LIBRARY_PATH:"+ph;
        end 
        envp[length(envp)] := getgtkdisplay();
        envp[length(envp)] :=nil;
        return 1;		
    end 
    function getgtkdisplay();
    begin
        try
            dsp := sys_getenv("DISPLAY");
            if dsp="" then dsp := ":0";
            if not ifstring(dsp) then dsp := ":0";
        except
            dsp := ":0";
        end;
        return "DISPLAY="+dsp;
    end 
		
    type tprocesswnd = class(TCustomControl)
        private 
        fidarraya;
        fidarrayb;
        fidarray;
        Fmsg;
        public 
        function create(AOwner);
        begin
            inherited;
            Visible := false;
            WsPopUp := true;
            ht :=Handle ;
            fidarray := array();
            fidarraya := array();
            fidarrayb := array();
            Fmsg := "";
            setlength(fmsg,1024);
            //bindmessage(WM_USER,thisfunction(wmuser));
        end 
        function addproc(pid,fid,obj,t);
        begin
            fidarray[pid] :=  fid;   
            fidarraya[pid] := obj; 
            fidarrayb[pid] := t;
            CallDatafunction(obj.OnPressStart,obj,pid);
            _send_(WM_USER,pid,fid,1);
            
        end 
        function proccount();
        begin
            return length(fidarrayb);
        end
        function clearproc();
        begin
            for i,v in mrows(fidarray,1) do 
            begin
                deleteproc(v);    
            end 
        end  
        function deleteproc(pid,flg);
        begin
            tsl_gtk_closehandle(fidarray[pid]);//删除fid
            reindex(fidarray,array(pid:nil)); 
            reindex(fidarraya,array(pid:nil)); 
            tp := 	fidarrayb[pid];	 
            if (tp .& 2) and ifnil(flg) then 
            begin 
                SysTerminate(1,pid);
            end        
            if tp .& 1 then 
            begin 
                ExitMessageLoop();
            end 
            reindex(fidarrayb,array(pid:nil)); 
        end 
        function wmuser(o,e):WM_USER;override;
        begin
            pid := e.wparam;
            fid := e.lparam;
            if pid and fid then 
            begin
                r := _wapi.tsl_gtk_pipread(fid,Fmsg,1024);
                if r=0 then 
                begin
                    deleteproc(pid,1); 
                    return ;       
                end else 
                if r>0 then 
                begin 
                    obj := fidarraya[pid];
                    obj.DoOnEcho(obj,Fmsg[1:r]);
                end else 
                begin 
                    sleep(20);		
                end                    
                _send_(WM_USER,pid,fid,1);    
            end     
        end 
        function Recycling();override;
        begin
            inherited;
            deleteproc();
        end 
    end 
		{$endif}
public
    function DoOnEcho(o,s);virtual;
    begin
        {**
        @explan(说明) 打印
        **}
        if not(CallMessgeFunction(FOnEcho,o,s))then
        begin
            echo s;
        end
    end
    function create();override;
    begin
        inherited;
        {$ifdef linux}
        if not FProcesswnd then FProcesswnd := new tprocesswnd(initializeapplication());
        {$endif}
        FBufSize := 1024;
    end
    function CreateProcessThread(exe,cmd);
    begin
    {$ifdef linux}
        if parserasexeclevparam(exe,cmd,e,arg,envp)then
        begin
            //echo tostn(arg);
            id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
            //1 跟着退出  2  4 
            ct := FProcesswnd.proccount();
            FProcesswnd.addproc(id,rh,self(true),0);
        end
        return id;
    {$endif}
        si := new T_startupinfoa();
        sa := new T_security_attributes();
        pi := new T_process_information();
        sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
        sa.nLength := sa._size_;
        //创建匿名管道
        w32 := gettswin32api();
        bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
        if not bRet then return 0;
        w32.GetStartupInfoA(si._getptr_);
        si.dwflags := 0x100;
        si.hStdOutput := hWrite;
        si.hStdError := hwrite;
        p := w32.CreateProcessA(nil,format('%s  %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
        return pi.hProcess;
    end
    function CreateProcessWaitRead(exe,cmd,hd,exitWithParent);
    begin
        {**
        @explan(说明) 执行代码,非阻塞当前线程 %%
        @param(exe)(string) 程序 %%
        @param(cmd)(string) 命令行 %%
        @param(hd)(pointer) 句柄,返回 %%
        @return(integer) 进程退出码 %%
        **}
        if FCurrentExeHandle then return;
        {$ifdef linux}
        if parserasexeclevparam(exe,cmd,e,arg,envp)then
        begin
            //echo tostn(arg);
            id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
            hd := id;
            FCurrentExeHandle := id;
            //1 跟着退出  2  4 
            ct := FProcesswnd.proccount();
            FProcesswnd.addproc(id,rh,self(true),(((exitWithParent or ifnil(exitWithParent))* 2).| 1));
            initializeapplication().run();
            if ct <> FProcesswnd.proccount()then
            begin
                FProcesswnd.clearproc();
            end
            FCurrentExeHandle := 0;
        end
        id := 0;
        return 0;
        {$endif}
        if not(FBufSize>100)then FBufSize := 1024;
        w32 := gettswin32api();
        si := new T_startupinfoa();
        sa := new T_security_attributes();
        pi := new T_process_information();
        sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
        sa.nLength := sa._size_;
        //创建匿名管道
        bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
        if not bRet then return 0;
        w32.GetStartupInfoA(si._getptr_);
        si.dwflags := 0x100;
        si.hStdOutput := hWrite;
        si.hStdError := hwrite;
        p := w32.CreateProcessA(nil,format('%s  %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
        hd := pi.hProcess;
        FCurrentExeHandle := hd;
        w32.CloseHandle(hWrite);
        if p then
        begin
            CallDatafunction(FOnPressStart,self(true),hd);
            szReadBuf := "";
            setlength(szReadBuf,FBufSize);
            nReadNum := 0;
            ct1 := 0;
            ct2 := 0;
            ct3 := 0;
            s := "123456";
            while w32.PeekNamedPipe(hRead,s,3,ct1,ct2,ct3) do
            begin
                if ct1 then
                begin
                    if w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)=0 then
                    begin
                        break;
                    end
                    tcs := szreadbuf[1:nreadnum];
                    DoOnEcho(self(true),tcs);
                end
                MSG := new TTagMSG();
                hmsg := MSG._getptr_;
                /////////////////////////////////////////////////////
                if(w32.PeekMessageA(hmsg,0,0,0,0x1))then
                begin
                    if MSG.message=0x12 then
                    begin
                        if exitWithParent or ifnil(exitWithParent)then SysTerminate(1,hd);
                        w32.PostQuitMessage(0);
                        break;
                    end else
                    begin
                        w32.TranslateMessage(hmsg);
                        w32.DispatchMessageA(hmsg);
                    end
                end else
                begin
                    tslprocessmessages(false);
                    RunWorkerThreadLoop();
                    w32.WaitMessage();
                end
                //////////////////////////////////////////					
            end
            hd := 0;
            w32.GetExitCodeProcess(pi.hProcess,cd);
            w32.CloseHandle(hRead);
            FCurrentExeHandle := 0;
        end
        return cd;
    end
    function CreateProcessWaitReadBlockThread(exe,cmd);
    begin
        {**
        @explan(说明) 阻塞当前线程等待输出 %%
        @param(exe)(string) 程序 %%
        @param(cmd)(string) 命令行 %%
        @return(integer) 进程退出码 %%
        **}
        {$ifdef linux}
        return 0;
        {$endif}
        if not(FBufSize>100)then FBufSize := 1024;
        w32 := gettswin32api();
        si := new T_startupinfoa();
        sa := new T_security_attributes();
        pi := new T_process_information();
        sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
        sa.nLength := sa._size_;
        //创建匿名管道
        bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
        if not bRet then return 0;
        w32.GetStartupInfoA(si._getptr_);
        si.dwflags := 0x100;
        si.hStdOutput := hWrite;
        si.hStdError := hwrite;
        p := w32.CreateProcessA(nil,format('%s  %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
        w32.CloseHandle(hWrite);
        if p then
        begin
            CallDatafunction(FOnPressStart,self(true),pi.hProcess);
            szReadBuf := "";
            setlength(szReadBuf,FBufSize);
            nReadNum := 0;
            while(w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)) do
            begin
                tcs := szreadbuf[1:nreadnum];
                DoOnEcho(self(true),tcs);
                nreadnum := 0;
            end
        end
        w32.GetExitCodeProcess(pi.hProcess,cd);
        w32.CloseHandle(hRead);
        return cd;
    end
    property BufSize read FBufSize write FBufSize;
    property OnEcho read FOnEcho write FOnEcho;
    property LastExeHandle read FCurrentExeHandle;
    property OnPressStart read FOnPressStart write FOnPressStart;
    private
    FOnPressStart;
    FCurrentExeHandle;
    {**
    @param(OnEcho)(function[TCreateProcessA,s:string]) 程序 %%
    **}
end 
type TMyArrayA = class(tstrindexarray)
    {**
    @explan(数组类型) 忽略字符串下标的大小写%%
    **}
    function create();
    begin
        inherited;
    end 
end 
type TMyArrayB =  class(tnumindexarray)
    {**
    @explan(说明) 数字下标数组对象 %%
    **}
    function create();
    begin
        inherited;
    end 
end 
type TTipMessageButton = class(TcustomTipMessageButton)
    function create(AOwner);
    begin
        inherited;
    end 
end 


   
type TInPutQuerys = class(TcustomInPutQuerys)
    function create(AOwner);
    begin
        inherited;
    end 
end 

implementation
///////////////tmf文件转换///////////////////////
type Ttfm2Component = class(TTmfParser)
    {**
    @explan(说明) tfm数据到组件转换 %%
    **}
    private
    static FComponentTypes;
    protected
    class function sinit();override;
    begin
        inherited;
        if not ifarray(FComponentTypes)then FComponentTypes := array();
    end
    function formatpath(s);//处理windows的路径
    begin
        r := "";
        if s and ifstring(s)then
        begin
            for i := 1 to length(s) do
            begin
                vi := s[i];
                if vi="/" then r += "\\";
                else r += vi;
            end
        end
        return r;
    end
    function GetExeScriptPath();
    begin
    {$ifdef linux}
        p := tsl_getcurrentdir_();
        return p+ioFileseparator()+SysParamstr(0);
    {$endif}
        pth2 := formatpath(sysparamstr(0));
        if pth2[2]=":" then return pth2;
        s := "";
        setlength(s,1024);
        N := GetCurrentDirectoryA(1023,s);
        return s[1:N]+ioFileseparator()+SysParamstr(0);
    end
    public
    class function RegisterComponentType(n,typ);
    begin
        if ifstring(n)and n and(typ is class(TComponent))then
        begin
            if not ifarray(FComponentTypes)then FComponentTypes := array();
            FComponentTypes[lowercase(n)]:= typ;
        end
    end
    class function GetComponentType(n);
    begin
        if(ifstring(n)and n)and ifarray(FComponentTypes)then
        begin
            nn := lowercase(n);
            r := FComponentTypes[nn];
            if r then return r;
            return findclass(nn);
        end
    end
    function SetTfmData(owner,obj,data,lazydata);
    begin
        u1 := obj.GetPublishproperties();
        u2 := obj.GetPublishEvents();
        if not ifarray(u1)then u1 := array();
        if not ifarray(u2)then u2 := array();
        pubs := u1 union u2;
        dprop := data["property"];
        ddp := array();
        for i,v in dprop do
        begin
            ddp[v["name"]]:= v;
        end
        for i,v in pubs do
        begin
            n := i;
            ddpv := ddp[n];
            if not ifarray(ddpv)then continue;
            cls := v["class"];
            et := GetComponentPropertyType(cls);//owner.GetPropertyType(cls);
            if not et then continue;
            td := SampleValue(ddpv);
            if et.LazyProperty()then
            begin
                if not ifarray(lazydata)then lazydata := array();
                lazydata[length(lazydata)]:= array("et":et,"owner":owner,"ownerp":td,
                    "obj":obj,"objp":n);
                continue;
            end
            d := et.ReadTMF(td,owner);
            if ifnil(d)then continue;
            try
                pbs := obj.publishs();
                if(n in pbs)then
                begin
                    //echo "\r\n====",n,"****",d;
                    invoke(obj,n,1,d);
                end else
                begin
                    //echo "pbs:",tostn(pbs);
                end
            except
                //echo obj.classinfo()["classname"],"错误 \r\n";
            end;
        end
        for i,v in data["object"] do
        begin
            n := v["name"];
            cls := v["class"];
            cobj := GetComponentType(cls);
            if cobj then
            begin
                nobj := createobject(cobj,owner);
                try
                    if(nobj is class(TToolBar))then
                    begin
                        for iii,iiiv in v["property"] do
                        begin
                            if(iiiv["name"]="align")and(iiiv["value"]="alnone")then
                            begin
                                nobj.Align := nobj.alNone;
                                break;
                            end
                        end
                    end
                    nobj.parent := obj;
                    invoke(owner,n,1,nobj);
                except
                end;
                call(thisfunction,owner,nobj,v,lazydata);
            end
        end
    end
    function Create();override;
    begin
        inherited;
    end
    function LoadFromTfmScript(owner,s);
    begin
        if s and ifstring(s)then
        begin
            self.Script := s;
            lazydata := array();
            //lazydata[0] := array();
            darray := gettree2(); 
            SetTfmData(owner,owner,darray,lazydata);
            for i,v in lazydata do
            begin
                try
                    dd := v["et"].ReadTMF(v["ownerp"],v["owner"]);
                    invoke(v["obj"],v["objp"],1,dd);
                except
                end;
            end
        end
    end
    function LoadFromTfm(owner);
    begin
        {**
        @explan(说明) 从默认路径导入tfm文件信息 %%
        **}
        Loadinherited(owner); //导入
    end
    private
    function hastfmfile(phs,cn);
    begin
        for i,v in phs do 
        begin
            pi := v+cn+".tfm";
            if fileexists("",pi) then 
            begin
                return true;
            end 
        end 
    end 
    function Loadtfmtoform(o,phs,cn);
    begin
        for i,v in phs do
        begin
            pi := v+cn+".tfm";
            size := filesize("",pi); //获取文件大小
            if readFile(rwraw(),"",pi,0,size,data)=1 then
            begin
                LoadFromTfmScript(o,data);
                return true;
            end
        end
    end
    function Loadinherited(o);//导入
    begin
        return Loadinherited_sub(o);
    end 
    function Loadinherited_sub(o);
    begin
        if not ifobj(o) then return ;  
        if not((o is class(TDCreateForm)) or (o is class(TDCreatePanel))) then return ;//判断类型   
        o2 := o;
        phs := static GetSourceDirs();
        objs := array();
        fssourdirs := phs;
        while true do 
        begin
            ci := o2.classinfo();
            cn := ci["classname"];
            if cn="tdcreateform" or cn="tdcreatepanel" then return ;
            if hastfmfile(phs,cn) then 
            begin
                Loadtfmtoform(o2,phs,cn);
                return ;
            end 
            ic := ci["inherited"][0];
            if ic then 
                o2 :=  findclass(ic,o2); 
            else return ;                  
        end        
    end  
    function GetSourceDirs();
    begin
        lps := GetLibPaths();
        lps[length(lps)] := static GetCurrentTslDir()+"funcext"+ioFileseparator();
        lps union2=array();
        r := array();
        for i,v in lps do 
        begin 
            GetReSourcetfmdir(v,r);
        end 
        return r;
    end 
    function GetReSourcetfmdir(p,rp);
    begin
        if not ifarray(rp) then rp := array();
        iofp := ioFileseparator();
        for ii,vv in filelist("",p+"*") do 
        begin
            fn :=  vv["FileName"];
            if fn="." or fn=".." then continue;
            if Pos("D",vv["Attr"]) then 
            begin 
                if lowercase(fn)="resource.tfm" then 
                begin 
                    rp[length(rp)] := p+"resource.tfm"+iofp;
                end else 
                begin 
                    GetReSourcetfmdir(p+fn+iofp,rp);     
                end 
            end 
        end 
    end
    function GetLibPaths(); //获得libpath
    begin
        p := tsl_getlibpath_();
        if not p then return array();
        FCurrentp := "";
        {$ifdef linux}
            FCurrentp := tsl_getcurrentdir_();
        {$else}
        s := "";
        setlength(s,1024);
        wapi := gettswin32api();
        N := wapi.GetCurrentDirectoryA(1023,s);
        FCurrentp := s[1:N];
        {$endif}
        FCurrentp1 := "";
        iofp := ioFileseparator();
        for i:= length(FCurrentp)-1 downto 1 do 
        begin
            if FCurrentp[i] = iofp then 
            begin 
                FCurrentp1 := FCurrentp[1:i-1];
                break;
            end 
        end 
        ri := 0;
        r := array();
        iofp2 := "."+iofp;
        iofp3 := ".."+iofp;
        for i,v in str2array(p,";") do 
        begin 
            vi := trim(v);
            if not vi then continue;
            if vi[length(vi)]<>iofp then continue;
            if pos(iofp2,vi)=1 then 
            begin  
                r[ri] := FCurrentp+vi[2:];
            end else 
            if pos(iofp3,vi)=1 then 
            begin 
                r[ri] := FCurrentp1+vi[3:];        
            end  
            else 
            begin
                r[ri] := vi;
            end    
            ri++; 
        end 
        return r;
    end
end 

type TGlobalComponentcache=class() //窗口对象缓存句柄作为索引
    {**
    @ignore(忽略) %%
    @explan(说明) 窗口存储类 %%
    @param(FWidowhandes)(array) 组件全局存储类 %%
    **}
    STATIC FWidowhandes;
    class function getwndbyhwnd(hwnd);
    begin
        {**
        @explan(说明) 根据id查找组件 %% 
        **}
        sinit();
        if ifnumber(hwnd)then return FWidowhandes[inttostr(hwnd)];
    end
    class function registerhandle(handle,o);
    begin
        {**
        @explan(说明)保存组件对象 %%
        **}
        sinit();
        if o is class(tcomponent)then
        begin
            //o.handle := handle;
            if ifnumber(handle)then FWidowhandes[inttostr(handle)]:= o;
        end
    end
    class function unregisterhandle(handle);
    begin
        {**
        @explan(说明)删除组件对象 %%
        **}
        sinit();
        if ifnumber(handle)then
        begin
            reindex(FWidowhandes,array(inttostr(handle):nil));
        end
    end
    class function sinit();
    begin
        {**
        @ignore(忽略) 忽略 %%
        @explan(说明)初始化 %%
        **}
        if not ifarray(FWidowhandes)then
        begin
            FWidowhandes := array();
        end
    end
end

type TDragManager=class(TComponent)
    private
    FDragImmediate:Boolean;
    FDragThreshold:Integer;
    protected //input capture
    procedure KeyUp(var Key:Word;Shift:TShiftState);virtual;
    procedure KeyDown(var Key:Word;Shift:TShiftState);virtual;
    procedure CaptureChanged(OldCaptureControl:TControl);virtual;
    procedure MouseMove(Shift:TShiftState;X,Y:Integer);virtual;
    procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);virtual;
    procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);virtual;
    public
    function Create(TheOwner:TComponent);override;
    function IsDragging():boolean;virtual;
    function Dragging(AControl:TControl):boolean;virtual;
    procedure RegisterDockSite(Site:TWinControl;DoRegister:Boolean);virtual;
    procedure DragStart(AControl:TControl;AImmediate:Boolean;AThreshold:Integer);virtual;
    procedure DragMove(APosition:TPoint);virtual;
    procedure DragStop(ADrop:Boolean);virtual;
    property DragImmediate:Boolean read FDragImmediate write FDragImmediate; // default True;
    property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5;
end;

function GetAndDispatchMessageA(hwnd,minm,maxm); //分发窗口消息
begin
    {**
    @explan(说明) 获得和分发消息 %%
    @param(hwnd)(pointer) 窗口句柄 默认为0 %%
    @param(minm)(integer) 最小消息值 默认为空 %%
    @param(maxm)(integer) 最大消息值 默认为空 %%
    @return(integer)0表示WM_QUIT ,-1表示错误,其他返回大于0 %%
    **}
    FMSG := new TTagMSG();
    ptr := FMSG._getptr_();
    API := gettswin32api();
    ///////////////////////////////////////////////
    if(API.PeekMessageA(ptr,0,0,0,0x1))then
    begin
        if FMSG.message=0x12 then
        begin
            return 0;
        end else
        begin
            API.TranslateMessage(ptr);
            API.DispatchMessageA(ptr);
        end
    end else
    begin
        tslprocessmessages(false);
        RunWorkerThreadLoop();
        API.WaitMessage();
    end
    return -1;
    //////////////////////////////////////////////////////
    {r := API.GetMessageA(ptr, hwnd>0?hwnd:0, minm>0?minm:0, maxm>0?maxm:0);
    if r=0 then  
    begin
    return r; 
    end 
    API.TranslateMessage(ptr);
    API.DispatchMessageA(ptr);}
    return r;
end
function RegisterComponentType(n,typ);//注册componet对象
begin
    {**
    @explan(说明) 注册component组件 %%
    **}
    class(Ttfm2Component).RegisterComponentType(n,typ);
end
function initializeapplication(); //应用对象
begin
    {**
    @explan(说明) 初始化application %%
    @return(tapplication) 窗口程序管理对象 %%
    **}
    return getapplication();
end
function getapplication(); //应用对象
begin
    {**
    @explan(说明) 返回application对象%%
    @return(tapplication) 应用对象 %%
    **}
    r := class(tUIglobalData).uigetdata("tuiapplication");
    if not(r)then
    begin
        r := new tapplication();
        class(tUIglobalData).uisetdata("tuiapplication",r);
    end
    return r;
    //return static new tapplication(); 
end
function gettswin32api(); //win32 api
begin
    {**
    @explan(说明) 返回win32api对象
    **}
    global G_O_TSWIN32API_;
    if not  G_O_TSWIN32API_ then  G_O_TSWIN32API_ := new tswin32api();
    return G_O_TSWIN32API_;
end
Function tslcstructure(data,dsize,pack,ptr);
Begin
    {**
    @explan(说明) 结构体排布计算 %%
    @param(data)(array)  结构体信息数组,参考 cstructurelib中 tslarraytocstructcalc %%
    @param(ssize)(integer)  大小  忽略%%
    @param(pack)(integer)  对其方式 忽略%%
    @return(tslcstructureobj) 内存分布对象 %%
    **}
    dt := unit(cstructurelib).MemoryAlignmentCalculate(data,1,dsize,pack);
    r := new tslcstructureobj(dt,ptr);
    return r;
End;

function tslcstructure_calc(data,baselen,ssize,pack);
begin
    {**
    @explan(说明) 结构体排布计算 %%
    @param(data)(array)  结构体信息数组,参考 cstructurelib中 tslarraytocstructcalc %%
    @param(baselen)(integer)  基准长度%%
    @param(ssize)(integer)  大小 %%
    @param(pack)(integer)  对其方式 %%
    **}
    return tslarraytocstructcalc(data,pack,0,ssize);
end

function remotetslcallback(data);//远程执行
begin
    {**
    @explan(说明) 行情订阅回调 %%
    **}
    class(TQuotations).Dispatch(data);
    //return class(TQuotations)._SWINDOWS._send_(0X4400,0,data,1);
end

function calldatafunction();//事件回调调用
begin
    {**
    @explan(说明)执行函数句柄,默认第一个参数为函数句柄,后面的参数为该句柄的参数 %%
    **}
    pc := paramcount;
    if pc<1 then return nil;
    f := params[1];
    if datatype(f)<> 7 then return nil;
    case pc of
        1:return call(f);
        2:return call(f,params[2]);
        3:return call(f,params[2],params[3]);
        4:return call(f,params[2],params[3],params[4]);
    end;
    return nil;
    {ps := params;
    f := ps[0];
    pms := ps[1:];
    if datatype(f)<> 7 or not(ifarray(pms))then exit;
    info := f.functioninfo();
    pt := info["parameter"];
    lpt := length(pt);
    if(lpt=0)or length(pms)<= lpt then
    begin
        return callinarray(f,pms);
    end else
    return callinarray(f,pms[0:lpt-1]);}
end
function NotifyComponent(Acomponent,Act,AOwner);//通知控件
begin
    {**
    @explan(说明) 通知节点AOwner有节点Acomponent 发生了改变,通知码为act %%
    @param(Acomponent)(tcomponent) 改变的节点 %%
    @param(Act)(member of TOperation) 通知码 %%
    @param(AOwner)(tcomponent|nil) 被通知的节点,默认采用application 对象 %%
    **}
    if not(Acomponent is class(tcomponent))then exit;
    owner := AOwner;
    if not(owner is class(tcomponent))then
    begin
        owner := getapplication();
    end
    owner.Notification(Acomponent,Act);
end
function _timeproc_(hwnd,message,wparam,lparam); //定时器消息分发
begin
    {**
    @explan(说明) 消息分发预处理函数被底层调用 %%
    @param(hwnd)(integer)  窗口句柄 %%
    @param(message)(integer) 消息id %%
    @param(lparam)(integer)  消息参数2  %%
    @param(wparam)(integer) 消息参数1 %%

    **}
    return class(ttimer)._timeproc_(hwnd,message,wparam,lparam);
end
function controlisCustomPaint(id);//提供给gtk使用
begin
    wd := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(id);
    if wd then return wd.isCustomPaint();
    return false;
end
function _twinproc_(hwnd,message,wparam,lparam); //窗口消息分发
begin
    {**
    @explan(说明) 消息分发预处理函数被底层调用 %%
    @param(hwnd)(integer)  窗口句柄 %%
    @param(message)(integer) 消息id %%
    @param(lparam)(integer)  消息参数2  %%
    @param(wparam)(integer) 消息参数1 %%

    **}
    //return gettswin32api().DefWindowProcA(hwnd,message,wparam,lparam);
    //echo format("\r\n%x\t%x\t%x\t%x",hwnd,message,wparam,lparam);
    //wdobj := class(TGlobalComponentcache).getwndbyhwnd(hwnd);
    //wdobj := uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
    wdobj := class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
    if ifnil(wdobj)then //没有注册 
    begin
        if message=0x81 then //如果为 WM_CREATE WM_NCCREATE 就注册 
        begin
            cpm := new tslcstructureobj(MemoryAlignmentCalculate(array(
                        ("lpcreateparams","intptr",0))),lparam);
            cid := cpm._getvalue_("lpcreateparams");
            wdobj := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(cid);
        end
    end
    r := 0;
    if wdobj then
    begin
        r := wdobj.MainWndProc(hwnd,message,wparam,lparam);
    end else
    begin
        //echo format("\r\n%x,%d,%x,%x",hwnd,message,wparam,lparam);
    end
    if message=0x82 then
    begin
        class(tUIglobalData).uigetdata("TGlobalComponentcache").unregisterhandle(hwnd);
    end
    return r;
end 
function _MessgeHook_a(hwnd,message,wparam,lparam);
begin
    {**
    @ignore(忽略)
    @explan(说明) 文件夹对话框回调函数,系统调用%%
    **}
    {
    // messages to browser
    0x0400
    #define BFFM_SETSTATUSTEXTA     (WM_USER + 100)
    #define BFFM_ENABLEOK           (WM_USER + 101)
    #define BFFM_SETSELECTIONA      (WM_USER + 102)
    #define BFFM_SETSELECTIONW      (WM_USER + 103)
    #define BFFM_SETSTATUSTEXTW     (WM_USER + 104)
    #define BFFM_SETOKTEXT          (WM_USER + 105) // Unicode only
    #define BFFM_SETEXPANDED        (WM_USER + 106) // Unicode only
	
    #define BFFM_INITIALIZED        1
    #define BFFM_SELCHANGED         2
    #define BFFM_VALIDATEFAILEDA    3   // lParam:szPath ret:1(cont),0(EndDialog)
    #define BFFM_VALIDATEFAILEDW    4   // lParam:wzPath ret:1(cont),0(EndDialog)
    #define BFFM_IUNKNOWN           5   // provides IUnknown to client. lParam: IUnknown*
    }
    //echo "\r\nhook",tostn(array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam)));
    if message=1 then
    begin
        gettswin32api().SendMessageA(hwnd,0x0400+102,TRUE,lparam);
    end
    return 0;
    if message=0x110 then //如果为 WM_CREATE WM_NCCREATE 就注册 
    begin
        s := array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam));
        d := new TtagOFNA(lparam);
    end
end
//function GetModuleFileNameA(m:pointer;var buf:string;len:integer):integer;stdcall;external "Kernel32.dll" name "GetModuleFileNameA";
//function CallWindowProcA(lpPrevWndFunc:pointer;hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll"  name "CallWindowProcA";
//function RegisterClassExA(wc:pointer):short;stdcall;external "User32.dll"  name "RegisterClassExA";
//tsl语言中使用动态库函数
function TS_EndExecute(id:integer);cdecl;external "TSSVRAPI.dll"  name "TS_EndExecute";
function TSL_ScriptGo(L:pointer;Content:string;v:pointer):integer;cdecl;external "TSSVRAPI.dll"  name "TSL_ScriptGo";
function TSL_InterpFreeLWrap(lWrap:pointer);cdecl;external "TSSVRAPI.dll"  name "TSL_InterpFreeLWrap";
function TSL_InterpNewLWrap():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TSL_InterpNewLWrap";
function TSL_NewObject():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TSL_NewObject";
function TSL_InterpGetLFromWrap(L:pointer):pointer;cdecl;external "TSSVRAPI.dll"  name "TSL_InterpGetLFromWrap";
function TS_GetGlobalL():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_GetGlobalL";
function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TSL_FreeObj";
//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_ExecPath";
//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetIniPath";
function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TSL_Check";
procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
function TS_GetUserProfileHome();
begin
    return unit(utslvclauxiliary).TS_GetUserProfileHome();
end
function RunWorkerThreadLoop(); //执行工作线程循环
begin
    class(TThreadWorker).dispatch();  
end 
	//procedure ClearScriptCache();cdecl;external  "TSLInterp.dll" name "ClearScriptCache";

function CreateDirWithFileName(fname);//确保指定文件的文件夹是存在的
begin
    return unit(utslvclauxiliary).CreateDirWithFileName(fname);
end

function DeleteAllFiles(path);//删除目录所有文件
begin
    return unit(utslvclauxiliary).DeleteAllFiles(path);
end

function LoginTslServer(usr,pwd,addr,port);//登陆服务器
begin
    {**
    @explan(说明) 登陆服务器 %%
    @param(usr)(string) 用户名 %%
    @param(pwd)(string) 密码 %%
    @return(int) 1 成功 0 失败 %%
    **}
    if not(port>0)then port := 443;
    if not(ifstring(addr))then addr := "tsl.tinysoft.com.cn";
    if(CheckConnected()or(ConnectServer(addr,port)=0))then
    begin
        msg := "";
        setlength(msg,200);
        if(CheckLogined()or LoginServer(usr,pwd,msg)=0)then
        begin
            //messagebox("进入管理界面","登陆成功",1);
            return 1;
        end;
        messageboxA(msg,"登陆失败",1);
        return 0;
    end else
    begin
        messageboxA("连接服务器失败","提示",1);
        return 0;
    end
    return 0;
end

function GetCheckStruct();
begin
    return new TCHECK_RESULT();
end
function CheckTslCode(code,err);//检查tsl语法
begin
    {**
    @explan(说明) tsl语法检查 %%
    @param(code)(string) tsl代码 %%
    @param(err)(string) 错误信息 %%
    @return(bool)成功返回true %%
    **}
    if not ifstring(code)then
    begin
        err := "非字符串";
        return false;
    end
    CheckInfo := static GetCheckStruct();
    if TSL_Check(code,length(code),CheckInfo._getptr_)<> 1 then
    begin
        err := CheckInfo.errmsg;
        return false;
    end
    return true;
end
function tslScriptGo(script);//执行tsl脚本
begin
    {**
    @explan(说明)执行tsl脚本 %%
    @param(script)(string) tsl语句 %%
    @return(bool) 1表示成功; 1 失败 %%
    @example(scriptgo-范例)
    script := "
    a := testabc();
    echo a;
    function testabc();
    begin
    return 10;
    end 
    ";
    return tslScriptGo(script);
    **}
    ph := gettemppath();
    file := ph+"tslpengt.tsl";
    if ifstring(script)and script then
    begin
        tsexe := SysExecName();
        FileDelete("",file);
        writefile(rwraw(),"",file,0,length(script),script);
        r := SysExec(tsexe,format('"%s" "%s"',tsexe,file),nil,0,r,nil);
    end
    return r;
    lwrap := TSL_InterpNewLWrap();
    L := TSL_InterpGetLFromWrap(lwrap);
    //L := TS_GetGlobalL();
    if ifstring(script)then
    begin
        v := TSL_NewObject();
        ret := TSL_ScriptGo(L,script,v);
        TSL_FreeObj(L,v);
    end
    //TSL_InterpFreeLWrap(lwrap);	
    return ret;
end
function version(); //版本
begin
    {**	
    @explan(说明) 返回版本号 %% 
    @return(string) "主版本号.次版本号.修订号.日期版本号 "
    **}
    //return "1.1.0.20190929_beta";
    //return "1.1.1.20200731_beta";
    //return "1.1.2.20210915_beta";
    //return "1.1.3.20220210_beta";
    return "1.1.4.20221111";
end
function ExitMessageLoop();
begin
    {**
    @expaln(说明)退出消息循环 %%
    **}
    WPI := gettswin32api();
    return WPI.PostQuitMessage(0);
end

function SysExecWait(handle,exe,cmd,dir,fwait); //等待执行
begin
    {**
    @explan(说明) 运行进程 %%
    @param(handle)(pointer) 返回进程句柄,作为返回值 %%
    @param(exe)(string) 执行程序 %%
    @param(cmd)(string) 命令行参数 %%
    @param(dir)(string) 目录 %%
    @param(fwait)(bool) 是否强行等待,默认为false %%
    **}
    if fwait then
    begin
        handle := SysExec(exe,cmd,dir,1,r);
        return r;
    end
    handle := SysExec(exe,cmd,dir,0,r);
    FMSG := new TTagMSG();
    msg := FMSG._getptr_;
    WPI := gettswin32api();
    while(handle) do
    begin
        {if (not WPI.GetMessageA(msg, 0, 0, 0)) then  break; 
        WPI.TranslateMessage(msg);
        WPI.DispatchMessageA(msg);}
        //////////////////////////////////////////////////////
        if(WPI.PeekMessageA(msg,0,0,0,0x1))then
        begin
            if FMSG.message=0x12 then
            begin
                break;
            end else
            begin
                WPI.TranslateMessage(msg);
                WPI.DispatchMessageA(msg);
            end
        end else
        begin
            tslprocessmessages(false);
            RunWorkerThreadLoop();
            WPI.WaitMessage();
        end
        ////////////////////////////////////////////////
        if not handle then break;
        if not SysWaitForSingleObject(handle,5)then
        begin
            handle := 0;
            return r;
        end
    end
    return r;
end
function MessageBoxA(txt,title,flag,wnd);//对话框api
begin
    {**
    @explan(说明) 提示对话框 %%
    @param(txt)(string) 文本 %%
    @param(title)(string) 标题 %%
    @param(flag)(integer) 按钮类型 %%
    @param(wnd)(twinControl) 父窗口 %%
    @return(integer) 值 %%
    **}
    hd := 0;
    if(wnd is class(TWincontrol))and wnd.HandleAllocated()then hd := wnd.Handle;
    else if ifnumber(wnd)then hd := wnd;
    return gettswin32api().MessageBoxA(hd,ifstring(txt)?txt:"",ifstring(title)?title:"",flag >= 0?flag:0);
end
function GetCurrentTslDir(); //获得tsl目录以\结尾
begin
    p := pluginpath();iofp := ioFileseparator();
    for i:= length(p)-1 downto 1 do 
    begin 
        if p[i]=iofp then 
        begin
            return p[1:i];
        end 
    end 
end 
function CopyUsedTslDllToNewDir(npre);//windows中使用,拷贝tsl使用的动态库到指定目录
begin
{**
    @explan(说明) 拷贝当前的tsl目录中使用的dll到指定目录%%
    @param(npre)(string) 新的指定目录 %%
**}
    if not ifstring(npre) then return false;
    if not (length(npre)>2) then return false;
    bpre := npre;
    if npre[length(npre)]=ioFileseparator() then 
    begin
        npre := npre[1:length(npre)-1];    
    end 
    pre1 := pre := GetCurrentTslDir(); 
    lpre := length(pre);
    app :=initializeapplication();
    d := app._wapi.Toolhelp32Snapshotmodule();
    pre := pre1;    
    for i,v in d do 
    begin 
        vi := v["szexepath"];
        if pos(pre,vi) then 
        begin
            fn := npre+vi[lpre:];
            CreateDirWithFileName(fn);
            FileCopy("",vi,"",fn,0);
        end 
    end 
    npre := bpre;
    return true;
end 

////////////////////封装已经移动到其他库的接口为了兼容///////////
function TslToHexFormatStr(tsl);//将tsl数据转换为16进制字符串
begin
    return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
end
function HexFormatStrToTsl(D);//将16进制字符串还原为tsl数据
begin
    return unit(utslvclauxiliary).HexFormatStrToTsl(d);
end
function GetTextWidthAndHeightWidthFont(s,f,mul);//获得字体的绘制高度宽度
begin
    return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
end 
function  CallMessgeFunction(f,o,e); //执行消息回调
begin
    return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);    
end 
/////////////////////////初始化////////////////////////////////////
function initallib();
begin 
    class(tUIglobalData).uisetdata("G_F_CONTROL_IS_CUSTOMPAINT",thisfunction(controlisCustomPaint));
    class(tUIglobalData).uisetdata("G_F_TWIN_PROC_",thisfunction(_twinproc_));
    class(tUIglobalData).uisetdata("G_F_TIME_PROC_",thisfunction(_timeproc_));
    class(tUIglobalData).uisetdata("G_T_TVCFORM_",class(TVCForm));
    class(tUIglobalData).uisetdata("G_T_TTFM2COMPONET_",class(Ttfm2Component));  
    class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
    class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
    class(TRegKey).sinit(); //初始化reg注册表
    //导入注册的componet
    vclini := pluginpath()+"tslvcl.ini";
    if fileexists("",vclini) then 
    begin
        ini := new TIniFileExta("",vclini);
        ini.LowerKey := true;
        for i,v in ini.ReadSectionValues("components") do  //控件
        begin
            if v then 
            begin
                cv := findclass(v);
                if cv then 
                begin
                    RegisterComponentType(i,cv);
                end 
            end   
        end 
        for i,v in ini.ReadSectionValues("propertys") do  //属性
        begin
            if v then 
            begin
                cv := findclass(v);
                if cv then 
                begin 
                    RegComponentPropertyType(createobject(cv));
                end 
            end         
        end     
    end     

end
function initlib();
begin
    {**
    @explan(说明) 初始化lib %%
    **}
    a := static initallib();
end

Initialization
    initlib();
Finalization
end.
{
    if message in array(1,0x81)then
    begin
        obj := new tslcstructureobj(MemoryAlignmentCalculate(array(
                    ("lpcreateparams","intptr",0),
                    ("hinstance","intptr",0),
                    ("hmenu","intptr",0),
                    ("hwndparent","intptr",0),
                    ("cy","int",0),
                    ("cx","int",0),
                    ("y","int",0),
                    ("x","int",0),
                    ("style","int",0),
                    ("lpszname","intptr",0),
                    ("lpszclass","intptr",0),
                    ("dwexstyle","int",0))),lparam);
        echo tostn(obj._getdata_);
    end
}