unit utslvclstdctl;
interface
{**
@explan(说明) 标准控件库 %%
@date(20220509)
**}
uses utslvclauxiliary,utslvclbase,utslvclgdi,utslvclaction,utslvclmenu;
type TcustomClipBoard=class(tcomponent) //剪切板基类
    {**
    @explan(说明) 剪切板类 %%
    **}
    private
    private
    FIsopen;
    function CloseClipboard(); //关闭
    begin
        if FIsopen then FIsopen := not _wapi.CloseClipboard();
        return not(FIsopen);
    end
    function OpenClipboard(); //打开
    begin
        {**
        @explan(说明) 打开剪切板 %%
        **}
        IF not(FIsopen)then FIsopen := _wapi.OpenClipboard(0);
        return FIsopen;
    end
    function EmptyClipboard();//清空
    begin
        {**
        @explan(说明) 清空剪切板 %%
        **}
        if FIsopen then _wapi.EmptyClipboard();
    end
    function SetText(s); //设置字符串
    begin
        {**
        @explan(说明) 设置字符串到剪切板 %%
        @param(s)(string|nil) 字符串如果为nil则清空 %%
        **}
        ret :=-1;
        if not(ifstring(s)and length(s)>0)then
        begin
            return -1;
        end
        OpenClipboard();
        try
            EmptyClipboard();
            _wapi.setclipboardtext(0,s);
        finally
            CloseClipboard();
        end;
        return ret;
    end
    function GetText(); //获得字符串
    begin
        {**
        @explan(说明) 获得剪切板字符串 %%
        @return(string) 字符串 %%
        **}
        OpenClipboard();
        try
            if _wapi.IsClipboardFormatAvailable(CF_TEXT)then
            begin
                r := _Wapi.getclipboardtext(0);
            end
        finally
            CloseClipboard();
        end;
        return r;
    end
    function SetBitmap(v); //设置图片
    begin
        if v is class(tcustombitmap)then
        begin
            if V.HandleAllocated()then
            begin
                OpenClipboard();
                try
                    EmptyClipboard();
                    _wapi.setclipboardbmp(v.Handle);
                finally
                    CloseClipboard();
                end;
                return ret;
            end
        end
    end
    function Getbitmap(); //获得图片
    begin
        OpenClipboard();
        try
            if _wapi.IsClipboardFormatAvailable(CF_BITMAP)then
            begin
                sid := _wapi.getclipboardbmp();
                if sid then
                begin
                    bmp := new tcustombitmap();
                    bmp.Handle := sid;
                    return bmp;
                end
                return false;
            end
        finally
            CloseClipboard();
        end;
        return r;
    end
    public
    function create(AOwner);override;
    begin
        {**
        @explan(说明) 构造剪切板类对象 %%
        **}
        inherited;
    end
    function Recycling();override;
    begin
        CloseClipboard();
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    property Text read GetText write SetText;
    property Bmp read GetBitmap write SetBitmap;
    {**
    @explan(Text)(string) 设置或者获取剪切板文本 %%
    **}
end
type TCustomTimer = class(tcomponent)//定时器类
    {**
    @explan(说明)定时器类,间隔是以毫秒为最小单位 %%
    **}
    {**
    @example(范例--定时器) 
    //构造计算器,第一个参数为间隔(毫秒),第二个为函数指针
    tm := new TCustomTimer(1000,function(o,e)begin echo now(); end );
    tm.start();//启动定时器
    tm.stop();//停止
    **}
    private
    static _STIMERS; //TIMER对象
    static FSIDC; //id 构造器
    class function Sgettimer(id);
    begin
        {**
        @explan(说明) 通过id获得定时器对象 %%
        @param(id)(integer)  定时器id %%
        **}
        return _STIMERS[id];
    end
    class function Ssettimer(tm);
    begin
        {**
        @explan(说明)存储定时器 %%
        @param(tm)(TCustomTimer)  定时器对象%%
        **}
        _STIMERS[tm.id]:= tm;
    end
    class function Sdeltimer(tid);
    begin
        {**
        @explan(说明) 删除定时器 %%
        @param(tid)(integer)  id%%
        **}
        if tid and(ifnumber(tid))then reindex(_STIMERS,array(tid:nil));
    end
    protected FOntimeout;
    private
    FOntimer;
    Fid;
    FInterval;
    FStart;
    _kill0; //标记
    function SetEnabled(f);
    begin
        if f then start();
        else stop();
    end
    function SetInterval(intv); //设置间隔
    begin
        {**
        @explan(说明)设置间隔 %%
        @param(intv)(integer) 间隔,毫秒 %%
        **}
        if not(ifnumber(intv))then return FInterval;
        if FStart then
        begin
            ndstart := 1;
            stop();
        end
        if intv <> FInterval and ifnumber(intv)and intv>0 then //时间不等
        begin
            FInterval := intv;
        end
        if ndstart then start();
    end
    public   
    {**
    	@param(FSIDC)(tidcreater)  id构造器%%
    	@param(_STIMERS)(array)  全局存储%%
    	@param(FOntimer)(fpointer)  timeout执行对象%%
    	@param(_kill0)(bool)  标记%%
    **}
    function create(AOwner);override;
    begin
        inherited;
        FID := FSIDC.createid();
        FStart := false;
        FInterval := 1000;
    end
    function timeout(cmd,t); //一次性事件
    begin
        {**
        @explan(说明) 一次性事件 %%
        @param(cmd)(fpointer) 执行回调 %%
        @param(t)(integer) t毫秒后执行 %%
        **}
        FOntimeout := cmd;
        if ifnumber(t)then SetInterval(t);
        FOntimer := function(o,e)
        begin
            try
                stop();
                CallMessgeFunction(FOntimeout,o,e);
            finally
                FOntimeout := nil;
            end;
        end;
        start();
    end
    function start(); //开始
    begin
        {**
        @explan(说明)启动 %%	
        **}
        if not((datatype(FOntimer) = 7 )and FInterval)>0 then return -1;
        if FStart then return FStart;
        ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2));
        _kill0 := ret;
        Ssettimer(self(true));
        FStart := ret <> 0;
        return FStart;
    end
    function stop(); //停止
    begin
        {**
        @explan(说明)停止 %%	
        **}
        if FStart then
        begin
            if _kill0 then
            begin
                FStart := not((_wapi.KillTimer(nil,_kill0))<> 0);
                if FStart=false then _kill0 := 0;
            end
            Sdeltimer(FID);
        end
        return not FStart;
    end
    function Recycling();override;
    begin
        {**
        @explan(说明)析构预备 %%
        **}
        stop();
        FSIDC.deleteid(FID);
        FOntimer := nil;
        FOntimeout := nil;
        FTimerStrc := nil;
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    class function _timeproc_(hwnd,message,wparam,lparam); //消息分发
    begin
        {**
        @explan(说明) 定时回调入接口 %%
        @param(hwnd)(integer)  窗口句柄 %%
        @param(message)(integer) 消息id %%
        @param(lparam)(integer)  消息参数2  %%
        @param(wparam)(integer) 消息参数1 %%
        **}
        e := new tuieventbase(message,wparam,lparam,hwnd);
        for i,iv in mrows(_STIMERS,1) do
        begin
            v := _STIMERS[iv];
            if v is class(TCustomTimer)then if v.tproc(e)then return;
        end
        //return _twinproc_(hwnd,message,wparam,lparam);
    end
    class function Sinit();override; //初始化
    begin
        {**
        @explan(说明)初始化定时器全局 %%
        **}
        if not FSIDC then
        begin
            _STIMERS := array();
            FSIDC := new tidcreater();
        end
        inherited;
    end
    function tproc(e);virtual; //分发定时器
    begin
        if e.wparam and(e.wparam=_kill0)then
        begin
            CallMessgeFunction(FOntimer,self(true),e);
            return 1;
        end
    end
    property Interval:integer read FInterval write SetInterval; //间隔
    property Ontimer:eventhandler read FOntimer write FOntimer; //回调
    property Enabled:bool read FStart Write SetEnabled; //启动
    property id read FID;
    {**
    @param(Interval)(integer) 设置运行间隔 %%
    @param(Ontimer)(funtion[self,tuieventbase]) 定时调度 %%	
    @param(Enabled)(bool) 是否已经启动 %%
    **}
end
type tcustombtn = class(TCustomControl) //按钮
		{**
		        @explan(说明) 普通按钮 %%
	**}
    function Create(aowner);
    begin
        inherited;
        
    end 
    function AfterConstruction();override;
    begin
        inherited;
        Caption:="button";
        Left:=0;
        Top:=0;
        Width:=94;
        Height:=31;
        Color :=  _wapi.GetSysColor(COLOR_MENUBAR);
    end 
    function click();virtual; //点击
    begin
    {**
        @explan(说明)模拟点击按钮一下的操作%%
    **}
        if handleAllocated() then _send_(BM_CLICK,0,0);
    end
    function BMCLICK(o,e):BM_CLICK;virtual; //点击消息处理
    begin
        if csDesigning in ComponentState then return ;
        if FdoingClick then return ;
        FdoingClick := true;
        //try
        if Action and Action.Execute() then 
        begin
            
        end else 
            CallMessgeFunction(onClick,self(true),e);   
        // finally
         FdoingClick := false; 
        // end;              
    end 
    function WMKEYDOWN(o,e);override; //按键enter处理
    begin
        inherited;
        case  e.CharCode of 
            13 :
            begin
                click();
            end 
        
        end ;
    end 
    function MouseDown(o,e);override; //按下
    begin   
        if csDesigning in ComponentState then return ;     
        if not Fbtnstate then 
        begin 
            Fbtnstate := true;
            InvalidateRect(nil,false);
        end 
        inherited;
    end 
    function MouseUp(o,e);override;//处理点击事件
    begin
        if csDesigning in ComponentState then return ;
        click();   
        if Fbtnstate then 
        begin
            Fbtnstate := 0;
            InvalidateRect(nil,false);
        end     
    end 
    {function WMLBUTTONUP(o,e):WM_LBUTTONUP;override;
    begin
        if csDesigning in ComponentState then return ;
        click();   
        if Fbtnstate then 
        begin
            Fbtnstate := 0;
            InvalidateRect(nil,false);
        end     
    end 
    function WMRBUTTONUP(o,e):WMRBUTTONUP;override;
    begin
        if csDesigning in ComponentState then return ;
        click();   
        if Fbtnstate then 
        begin
            Fbtnstate := 0;
            InvalidateRect(nil,false);
        end     
    end }
    function dosetfocus(o,e);override;//获得焦点
    begin
        {**
        @explan(说明) 控件获得焦点 %%
        @param(o)(TWinControl) 控件自身 %%
        @Param(e)(tuieventbase) 消息对象 %%
        **}
        inherited;
        FBtnfocused := true;
        InvalidateRect(nil,false);
    end
    function dokillfocus(o,e);override;//失掉焦点
    begin
        {**
        @explan(说明) 控件失去焦点 %%
        @param(o)(TWinControl) 控件自身 %%
        @Param(e)(tuieventbase) 消息对象 %%
        **}
        inherited;
        FBtnfocused := false;
        InvalidateRect(nil,false);
    end

    function paint();override;//绘制
    begin            
        if Fbtnstate then 
        begin 
            PaintMouseDown(); 
        end  else 
        if FBtnfocused then 
        begin 
            paintfocus(self.Canvas,self.ClientRect);
        end       
        rec := GetBtntextRect();
        if not ifarray(rec) then return ;
        if not (rec[2]>rec[0] and rec[3]>rec[1]) then return ;
        {
        AL9_DEFAULT := 0;//0
    			AL9_TOPLEFT := 1;//1
    			AL9_TOPCENTER := 2 ;//2
    			AL9_TOPRIGHT := 3;//3
    			AL9_CENTERLEFT := 4 ;//4
    			AL9_CENTER := 5 ;//5
    			AL9_CENTERRIGHT := 6;//6
    			AL9_BOTTOMLEFT := 7 ;//7
    			AL9_BOTTOMCENTER := 8;//8
    			AL9_BOTTOMRIGHT := 9;//9	
        }
        df := 0;
        case FtextPosition of 
            1:    df := DT_LEFT;
            2:    df := DT_CENTER;
            3:    df := DT_RIGHT
            4:    df := DT_LEFT .| DT_VCENTER;   
            6:    df := DT_RIGHT .| DT_VCENTER;
            7:    d := DT_BOTTOM .| DT_LEFT;
            8:    df := DT_BOTTOM .|DT_CENTER;
            9:    df := DT_BOTTOM .| DT_RIGHT;
            else 
            begin
                df := DT_CENTER .| DT_VCENTER .| DT_SINGLELINE;
            end             
        end ;
        dc := Canvas;
        c := caption;  
              
        if ifstring(c) and c then 
        begin
            dc.font := font;
            flg := 0;
            if not Enabled then 
            begin 
                bc := dc.font.color;
                dc.font.color := 0xc0c0c0;
                flg := 1;
            end                 
            dc.drawtext(c,rec,df);
            if flg then 
            begin 
                dc.font.color := bc;    
            end 
        end 
        
    end 
    function FontChanged(o);override; //字体改变
    begin
        inherited;
        InvalidateRect(nil,false);
    end 
    function Recycling();override;
    begin
        inherited;
        FonSetFocus := nil;
        FonKillFocus := nil;
    end 
    property textPos:AlignStyle9 read FtextPosition write setTextPosition; //文字对齐
    property pushLike:bool read FpushLike write setPushLike;  
    property multiLine:bool read FmultiLine write setMultiLine;
    {**
    @param(textPos)(member of TAlignStyle9) 文本位置%%
    @param(pushLike)(bool)是否为普通按钮外观%%
    @param(multiLine)(bool)文本是否为多行显示%%
    **}
    protected
    function SetEnabled(v);override;
    begin
        nv := v?true:false;
        if nv<>Enabled then 
        begin
            inherited;
            if HandleAllocated() then 
                InvalidateRect(nil,false);
        end 
    end 
    function RealSetText(s);override;
    begin
        bs := caption;            
        inherited;
        if bs = caption then return ;
        InvalidateRect(nil,false);
    end 
    function PaintMouseDown();virtual; //按下绘制
    begin
        r := ClientRect;
        dc := Canvas;
        bps := dc.pen.style;
        {dc.pen.color := rgb(150,200,230);
        dc.pen.width := 1;
        dc.pen.style := PS_SOLID;        
        drawrc(dc,r,1);}
        paintfocus(dc,r);
        dc.pen.style := PS_DOT;
        dc.pen.color := rgb(170,220,250);
        drawrc(dc,r,4);
        dc.pen.style := bps;
    end 
    private 
    function paintfocus(dc,r); //绘制焦点
    begin
        dc.pen.color := rgb(150,200,230);
        dc.pen.width := 1;
        dc.pen.style := PS_SOLID;        
        drawrc(dc,r,1);
    end 
    function drawrc(dc,r,n);
    begin
        r[0] += n;
        r[2] -= n;
        r[1] += n;
        r[3] -= n;
        dc.moveto(r[array(0,1)]);
        dc.LineTo(r[array(2,1)]);        
        dc.LineTo(r[array(2,3)]);
        dc.LineTo(r[array(1,3)]);
        dc.LineTo(r[array(0,1)]);    
    end 
    function setPushLike();
    begin
    
    end 
    function setMultiLine();
    begin
    
    end 
    function GetBtnTextRect();virtual;
    begin
        return ClientRect;
    end 
    function setTextPosition(n);
    begin
        if not ifnumber(n) or n<0 or n>9 then
            n:=0;
        else
            n:=integer(n);
        if FtextPosition=n then return ;
        FtextPosition:=n;
        InvalidateRect(nil,false);
    end 
    private 
    FBtnfocused;
    FdoingClick;
    FpushLike;
    FmultiLine;
    FtextPosition;
    Fbtnstate;
end 
type tcustomcheckbtn=class(tcustombtn) //checkbtn
    {**
    @explan(说明) 复选框 %%
    **}
    //BM_SETCHECK
    public
    function create(aowner);override;
    begin
        inherited;
        FcheckState:=0;
        FleftText:=0;
    end
    function click();override;
    begin
        FcheckState := not FcheckState;
        _send_(BM_SETCHECK,FcheckState,0 );
        inherited;    
    end 
    function paint();override;
    begin
        inherited;
        drawchekd(FCheckRect);
    end 
    function BMSETCHECK(o,e):BM_SETCHECK;virtual;
    begin
        FcheckState := e.wparam;   
        InvalidateRect(nil,false); 
    end     
    property checked:bool read FcheckState write setChecked;
    property leftText:bool read FleftText write setLeftText;
    {**
        @param(checked)(integer)勾选状态：
            0：未选中。
            1：选中。
        @param(leftText)(bool)文本是否在左%%
    **}
    private 
    FleftText;
    FcheckState;
    FCheckRect;
    private 
    function drawchekd(r);virtual; //绘制选择按钮
    begin
        if r then 
        begin
            dc := Canvas;
            dc.pen.style := PS_SOLID;
            dc.brush.color := rgb(200,0,0);
            dc.Draw("framecontrol",array(r[0:1],r[2:3]),DFC_BUTTON,(checked)?DFCS_CHECKED:DFCS_BUTTONCHECK);
        end 
    end 
    function setChecked(v);virtual; //设置选择
    begin
        nv := v?true:false;
        if nv<>FcheckState then 
        begin
            FcheckState := nv;
            if handleAllocated() then _send_(BM_SETCHECK,FcheckState,0);    
        end                 
    end 
    function setLeftText(v);
    begin
        nv := v?true:false;
        if FleftText<>nv then 
        begin
            FleftText := nv;
            InvalidateRect(nil,false);
        end 
    end 
    function GetBtnTextRect();virtual; //选择框位置计算
    begin
        r :=  ClientRect;
        h := r[3]-r[1];
        dh := integer( (h-16)/2)+1; 
        if FleftText then 
        begin                      
            FCheckRect := array(r[2]-18,r[1]+dh,r[2]-2,r[3]-dh);
            r[2] -=20;  
        end else 
        begin
            FCheckRect := array(r[0]+2,r[1]+dh,r[0]+18,r[3]-dh);
            r[0] +=20;
        end 
        return r;
    end 
end
type tcustomradiobtn = class(tcustomcheckbtn) //单选按钮
    {**
    @explan(说明)radiobtn单选按钮控件
    **}
    function create(AOwner);
    begin
        inherited;  
    end 
    function InitializeWnd();override;
    begin
        inherited;
        ck := checked;
        if ck then 
            _send_(BM_SETCHECK,ck,0); 
    end 
    function click();override;
    begin
        if checked then 
        begin 
            _send_(BM_CLICK,0,0);
        end else 
            inherited;    
    end 
    function BMSETCHECK(o,e):BM_SETCHECK;override;
    begin
        t := e.wparam; 
        inherited;  
        if t then 
        begin
            p := parent ;
            ctls := p.Controls;
            for i := 0 to ctls.count-1 do 
            begin
                ci := ctls[i];
                if ci is class(tcustomradiobtn) then 
                begin
                    if ci=self(true) then continue;
                    if ci.checked then 
                    begin
                        ci.checked := false;
                    end 
                end 
            end 
        end  
    end 

    private  
    function drawchekd(r);override;
    begin
        if r then 
        begin
            dc := Canvas;
            dc.pen.style := PS_SOLID;
            dc.brush.color := rgb(200,0,0);
            dc.Draw("framecontrol",array(r[0:1],r[2:3]),DFC_BUTTON,DFCS_BUTTONRADIO);
            if checked then 
            begin 
                r2 := array(r[0:1]+3,r[2:3]-3);
                dc.brush.color := 0;
                dc.draw("ellipse",r2);
            end 
        end     
    end 
end
type teditable=class(TSLUIBASE)  //编辑控件基类
    private
    FInsertState;
    FReadOnly;
    FLineWrap;
    FString;
    FCaretX;
    FLeftCharCount;
    Flimitlength;
    FSelBegin;
    FSelLength;
    FCanShowCaret;
    FFontWidth;
    FFontHeight;
    FCaretY;
    FMouseLbuttonDown;
    FHafChar; //半个中文
    FBorder;
    //////////////////////
    FHost; //
    FHostDc;
    FClientRect;
    FFont;
    FVisible;
    function SetVisible(v); //可见
    begin
        nv := v?true:false;
        if nv <> FVisible then
        begin
            FVisible := nv;
            if not(FVisible)and FSetFocused then
            begin
                KillFocus();
                InvalidateRect(nil,false);
            end
            CalcFontSize();
        end
    end
    function SetFont(f); //字体改变
    begin
        if f then
        begin
            FFont := f;
            if FCanShowCaret and FHost and FHost.HandleAllocated() and FHost.Handle=_wapi.GetFocus() then
            begin
                recreateCarete();
                return InvalidateRect(nil,false);
            end
            CalcFontSize();
            InvalidateRect(nil,false);
            updatecaret();
        end
    end
    function InvalidateRect(rec,flg); //刷新
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            FHost.InvalidateRect(rec?rec:FClientRect,flg);
        end
    end
    function SetHost(host); //设置宿主
    begin
        if FHost=host then return;
        ohost := FHost;
        FHost := nil;
        if host is class(TWinControl)then
        begin
            SetFont(host.font);
            FHost := host;
        end else
        begin
            if ohost then ohost.InvalidateRect(GetEntryRect(),false);
        end
    end
    function SetBorder(v); //边框
    begin
        n := v?true:false;
        if n <> FBorder then
        begin
            FBorder := n;
            InvalidateRect(nil,false);
        end
    end
    Function Setplaceholder(p); //提示
    begin
        if p and ifstring(p)and Fplaceholder <> p then
        begin
            Fplaceholder := p;
            if FHost and not(FString)and FHost.HandleAllocated()then InvalidateRect(nil,false);
        end
    end
    function recreateCarete();//重构光标
    begin
        DestroyCaret();
        CreateCaret();
    end
    function CreateCaret(); //构造光标
    begin
        if not(FReadOnly)and not(FCanShowCaret)and FHost and FHost.HandleAllocated()then
        begin
            CalcFontSize();
            h := FFontHeight+4;
            hd := FHost.Handle;
            _wapi.CreateCaret(hd,nil,1,h);
            _wapi.ShowCaret(hd);
            FCanShowCaret := true;
        end
        FIsCaretShow := true;
    end
    function DestroyCaret(); //销毁光标
    begin
        if FCanShowCaret and FHost and FHost.HandleAllocated()then
        begin
            _wapi.HideCaret(FHost.Handle);
            _wapi.DestroyCaret();
            FCanShowCaret := false;
        end
        FIsCaretShow := false;
    end
    function updatecaret();//更新光标
    begin
        if FCanShowCaret and FHost and FHost.HandleAllocated()then
        begin
            rec := GetEntryRect();
            cx :=(FCaretX-FLeftCharCount-1) * FFontWidth+rec[0];
            _Wapi.SetCaretPos(cx,FCaretY);
        end
    end
    function InitSel();//取消选择
    begin
        FSelBegin := FCaretX;
        FSelLength := 0;
    end
    function GetCharPosByX(x);
    begin
        rc := GetEntryRect();
        cp := FLeftCharCount+integer((x-rc[0])/FFontWidth+0.4)+1;
        if bytetype(FString,cp)=2 then return cp+1;
        return cp;
    end
    function CalcFontSize();
    begin
        FFontWidth := font.width;
        FFontHeight := font.Height;
        rec := GetEntryRect();
        FCaretY := max(0,integer((rec[1]+(rec[3]-rec[1]-FFontHeight)/2))-2);
    end
    function setReadOnly(v);
    begin
        nv := v?true:false;
        if nv <> FReadOnly then
        begin
            FReadOnly := nv;
            InvalidateRect(nil,false);
        end
    end
    function setEditText(s); //设置文本
    begin
        if ifstring(s)and s <> FString then
        begin
            s1 := filterstring(s);
            if s1=fstring then return;
            if fcanundo and (fundolist.locked<1) then  
            begin
                fundolist.AddChange("del",1,-1,FString);
                fundolist.AddChange("ins",1,-1,s1);
            end 
            FString := s1;
            if FCaretX=1 then
            begin
                InitSel();
                InvalidateRect(nil,false);
            end else
            MoveCaretTo(1,0);
            doOnChange();
        end
    end
    function setLimitLength(n);
    begin
        if n >= 0 and n <> Flimitlength then
        begin
            Flimitlength := n;
        end
    end
    function MoveCaretTo(x_,ifsel);
    begin
        if x_<1 then x := 1;
        else x := min(x_,length(FString)+1);
        if x=FCaretX then return;
        rec := GetEntryRect();
        x1 := FLeftCharCount+1; //rec[0];
        fw := font.width;
        x2 := integer((rec[2]-rec[0])/fw);
        if x<x1 then
        begin
            FLeftCharCount -=(x1-x);
        end else
        if x>(x1+x2)then
        begin
            FLeftCharCount +=(x-x1-x2);
        end
        FCaretX := x;
        ////////////显示光标位置////////////////////        
        //_wapi.SetCaretPos();
        if ifsel then
        begin
            FSelLength := x-FSelBegin;
        end else
        InitSel();
        InvalidateRect(nil,false);
        updatecaret();
    end
    function selectall();//全选
    begin
        if FString and(FSelBegin <> 1 or FSelLength <> length(FString))then
        begin
            FSelBegin := 1;
            FSelLength := length(FString);
            InvalidateRect(nil,false);
        end
    end
    function getselstring(b,e);//获得选择的
    begin
        if FSelLength <> 0 then
        begin
            x1 := FSelBegin-(FSelLength<0);
            X2 := FSelBegin+FSelLength-(FSelLength>0);
            b := min(x1,x2);
            e := max(x1,x2);
            return FString[b:e];
        end
        return "";
    end
    function DeleteSel();//删除选中
    begin
        if FSelLength <> 0 then
        begin
            x1 := FSelBegin-(FSelLength<0);
            X2 := FSelBegin+FSelLength-(FSelLength>0);
            b := min(x1,x2);
            e := min(max(x1,x2),length(FString));
            if fcanundo and (fundolist.locked<1) then fundolist.AddChange("del",b,e,FString[b:e]);
            FString[b:e]:= "";            
            cx := max(1,min(x1,x2));
            InitSel();
            BeginUpDate();
            InvalidateRect(nil,false);
            MoveCaretTo(cx,0);
            DeletePerfect();
            EndUpDate();
            doOnChange();
        end
    end
    function DeletePerfect();//向前删除
    begin
        if FLeftCharCount>0 then
        begin
            sz := FFontWidth * (length(FString)-FLeftCharCount);
            rec := GetEntryRect();
            syl :=((rec[2]-rec[0]-sz)/FFontWidth);
            if syl>1 then
            begin
                FLeftCharCount := max(0,FLeftCharCount-integer(syl));
                updatecaret();
                InvalidateRect(nil,false);
            end
        end
    end
    function dodelete();//向后删除
    begin
        if FReadOnly then return;
        if FSelLength <> 0 then return deletesel();
        len := length(FString);
        if FCaretX <= length(FString)then
        begin
            b := FCaretX;
            if bytetype(FString,FCaretX)=1 then
            begin
                e := FCaretX+1;
                //FString[(FCaretX):(FCaretX+1)]:= "";
            end else
            begin
                e := b;
                //FString[(FCaretX):(FCaretX)]:= "";
            end
            if fcanundo and (fundolist.locked<1) then fundolist.AddChange("del",b,e,FString[b:e]);
            FString[b:e] := "";
            BeginUpDate();
            InvalidateRect(nil,false);
            DeletePerfect();
            EndUpDate();
            doOnChange();
        end
    end
    function BeginUpDate(); //锁定
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            FHost.BeginUpDate();
        end
    end
    function EndUpDate();
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            FHost.EndUpDate();
        end
    end
    function dobackspace();//backsapce处理
    begin
        if FReadOnly then return;
        if FSelLength <> 0 then return deletesel();
        len := length(FString);
        if FCaretX>1 then
        begin
            cx := FCaretX;
            e := FCaretX-1;
            if bytetype(FString,FCaretX-1)=2 then
            begin
                b := FCaretX-2;//FString[(FCaretX-2):(FCaretX-1)]:= "";
                cx -= 2;
            end else
            begin
                b := FCaretX-1;//FString[(FCaretX-1):(FCaretX-1)]:= "";
                cx--;
            end            
            if fcanundo and (fundolist.locked<1) then fundolist.AddChange("del",b,e,FString[b:e]);
            FString[b:e]:= "";
            BeginUpDate();
            MoveCaretTo(cx,0);
            DeletePerfect();
            EndUpDate();
            doOnChange();
        end
    end
    function GetCBoard(); //剪切板
    begin
        if not FCopyer then
        begin
            FCopyer := new TcustomClipBoard(class(tUIglobalData).uigetdata("tuiapplication"));
        end
        return FCopyer;
    end
    function CopyToClipboard(); //复制选择
    begin
        r := getselstring();
        GetCBoard().text := r;
    end
    function PasteFromClipBoard();//粘贴
    begin
        if readonly then return;
        t := GetCBoard().text;
        if t then InsertChar(t);
    end
    protected
    function doOnChange();virtual;
    begin
    end
    function doonmaxtext();virtual;
    begin
    end
    function doonsetfocus();virtual;
    begin
    end
    function doonkillfocus();virtual;
    begin
    end
    function filterstring(c);virtual; //过滤
    begin
        s1 := "";
        if ifstring(c)and c then
        begin
            s1 := replacetext(c,"\r","");
            s1 := replacetext(s1,"\n","");
            s1 := replacetext(s1,"\t"," ");
        end
        return s1;
    end
    function PaintBorder();virtual;
    begin
        if FBorder or(FFocusBorder and FSetFocused)then
        begin
            rbc := ClientRect;
            if ifarray(rbc)and rbc[2]>rbc[0]and rbc[3]>rbc[1]then
            begin
                dc := FHost.Canvas;
                dc.pen.width := 1;
                if FSetFocused then dc.pen.color := rgb(200,150,150);
                else dc.pen.color := rgb(180,180,180);
                dc.brush.Color := FHost.Color;
                dc.draw("RoundRect",array(rbc[0:1],rbc[2:3],array(3,3)));
            end
        end
    end
    function PaintPlaceHolder(rec);virtual;
    begin
        if not(FString)and Fplaceholder and ifstring(Fplaceholder)then
        begin
            dc := FHost.Canvas;
            bc := dc.font.color;
            dc.font.color := Fplaceholdercolor;
            dc.drawtext(Fplaceholder,rec,DT_VCENTER .| DT_SINGLELINE);
            dc.font.color := bc;
            return true;
        end
    end
    function PaintText(s,rec);virtual;
    begin
        if FHost and FHost.HandleAllocated()and ifstring(s)and s then
        begin
            dc := FHost.Canvas;
            if not dc.HandleAllocated()then return;
            neb := not(FHost.Enabled);
            if neb then
            begin
                dc.font.Color := 0xc0c0c0;
            end
            if FMarked then
            begin
                ns := s;
                if ifstring(FPassWordChar)and FPassWordChar then vc := FPassWordChar[1];
                else vc := "#";
                for i := 1 to length(ns) do
                begin
                    ns[i]:= vc;
                end
                dc.drawtext(ns,rec,DT_VCENTER .| DT_SINGLELINE);
            end else
            dc.drawtext(s,rec,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
        end
    end
    public
    function create();
    begin
        Fplaceholdercolor := rgb(200,200,200);
        fselbkcolor := rgb(51,153,255);
        freadonlyColor := rgb(240,240,240);
        FVisible := true;
        FReadOnly := false;
        FFocusBorder := true;
        FString := "";
        FSelBegin := 1;
        FSelLength := 0;
        FBorder := true;
        FCaretX := 1;
        FLeftCharCount := 0; //1;
        FFont := new Tcustomfont();
        fundolist := new tedolist();
        fredolist := new tedolist();
        fcanundo := true;
    end
    function InsertChar(c_); //插入
    begin
        if FSelLength <> 0 then
        begin
            dobackspace();
        end
        len := length(FString);
        c := filterstring(c_);
        if not(ifstring(c)and c)then return;
        if Flimitlength>0 then
        begin
            if Flimitlength <= len then
            begin
                doonmaxtext();
                return;
            end else
            begin
                clen := length(c);
                nct := Flimitlength-len;
                if nct<clen then
                begin
                    if bytetype(c,nct)=1 then
                    begin
                        ns := c[1:nct+1];
                    end else
                        ns := c[1:nct];
                    return InsertChar(ns);
                end
            end
        end
        rc := GetEntryRect();
        if LineWrap then
        begin
            if(FFontWidth * (len+1))>(rc[2]-rc[0])then return;
        end
        if fcanundo and (fundolist.locked<1) then fundolist.AddChange("ins",FCaretX,-1,c);
        if FCaretX=1 then
        begin
            FString := c+FString;
        end else
        if FCaretX=length(FString)+1 then
        begin
            FString += c;
        end else
        begin
            FString[FCaretX:0]:= c;
        end
        MoveCaretTo(FCaretX+length(c),0);
        doOnChange();
    end
    function ExecuteCommand(cmd,pm);virtual;
    begin
        case cmd of
            "canundo":
            begin
                fcanundo := pm;
            end 
            "ecundo":
            begin
                undo();
            end
            "ecredo":
            begin
                redo();
            end 
            "echome":
            begin
                MoveCaretTo(1,pm);
            end
            "ecend":
            begin
                MoveCaretTo(length(FString)+1,pm);
            end
            "ecreadonlycolor":
            begin
                if pm>0 or pm<0 then freadonlyColor := pm;
                return freadonlyColor;
            end
            "ecselbkcolor":
            begin
                if pm>0 or pm<0 then fselbkcolor := pm;
                return fselbkcolor;
            end
            "ecplaceholdercolor":
            begin
                if pm>0 or pm<0 then Fplaceholdercolor := pm;
                return Fplaceholdercolor;
            end
            "ecinsert":
            begin
                if ifstring(pm)and pm then InsertChar(pm);
            end
            "ecleft":
            begin
                if FCaretX>1 then MoveCaretTo(FCaretX-(1+(bytetype(FString,FCaretX-1)=2)),pm);
            end
            "ecright":
            begin
                if FCaretX <= length(FString)then MoveCaretTo(FCaretX+(1+(bytetype(FString,FCaretX)=1)),pm);
            end
            "ecselall":
            begin
                selectall();
            end
            "ecsel":
            begin
                if ifarray(pm)and pm[0]>0 and pm[1]>0 then
                begin
                    MoveCaretTo(pm[0],0);
                    MoveCaretTo(Pm[1],1);
                end
            end
            "ecclcsel":
            begin
                if FSelLength <> 0 then
                begin
                    InitSel();
                    InvalidateRect(nil,false);
                end
            end
            "ecgetsel":
            begin
                r := getselstring(b,e);
                pm := array(b,e);
                return r;
            end
            "ecdelete":
            begin
                dodelete();
            end
            "ecbackspace":
            begin
                dobackspace();
            end
            "eccopy":
            begin
                CopyToClipboard();
            end
            "ecpaste":
            begin
                PasteFromClipBoard();
            end
            "eccut":
            begin
                CopyToClipboard();
                DeleteSel();
            end
            "ecpasswordchar":
            begin
                if ifstring(pm)and pm then FPassWordChar := pm[1];
                else return FPassWordChar;
            end
            "ecmarked":
            begin
                if ifnil(pm)then
                begin
                    return FMarked;
                end else
                begin
                    nv := pm?true:false;
                    if FMarked <> nv then
                    begin
                        FMarked := nv;
                        InvalidateRect(nil,false);
                    end
                end
            end
            "ecgetposbyx":
            begin
                if x >= 0 or x<0 then return GetCharPosByX(x);
            end
            "eccaretpos":
            begin
                return FCaretX;
            end
            "ecclear":
            begin
                fundolist.lock();
                selectall();
                dodelete();
                fundolist.clear();
                fredolist.clear();
                fundolist.lock();
            end 
        end;
    end
    function GetEntryRect();virtual;
    begin
        r := ClientRect;
        if not ifarray(r)then return array(0,0,0,0);
        r[0]+= 1;
        r[2]-= 1;
        r[1]+= 1;
        r[3]-= 1;
        return r;
    end
    function WMKEYUP(o,e);virtual;
    begin
        if FOnKeyUp then 
        begin
            CallMessgeFunction(FOnKeyUp,o,e);
            if e.skip then return ;
        end     
    end 
    function WMKEYDOWN(o,e);virtual;//按键
    begin
        if FOnKeyDown then 
        begin
            CallMessgeFunction(FOnKeyDown,o,e);
            if e.skip then return ;
        end     
        fsft := ssShift in e.shiftstate;
        fctl := ssCtrl in e.shiftstate;
        case e.CharCode of
            VK_INSERT:
            begin
                FInsertState := not FInsertState;
            end
            VK_LEFT:
            begin
                ExecuteCommand("ecleft",fsft);
            end
            VK_RIGHT:
            begin
                ExecuteCommand("ecright",fsft);
            end
            VK_DELETE:
            begin
                dodelete();
            end
            VK_HOME:
            begin
                ExecuteCommand("echome",fsft);
            end
            VK_END:
            begin
                ExecuteCommand("ecend",fsft);
            end
            ord("Z"):
            begin
                if fctl then
                begin
                    ExecuteCommand("ecundo",0);
                end
            end 
            ord("C"):
            begin
                if fctl then
                begin
                    ExecuteCommand("eccopy");
                end
            end
            ord("V"):
            begin
                if fctl then
                begin
                    ExecuteCommand("ecpaste");
                end
            end
            ord("X"):
            begin
                if fctl then
                begin
                    ExecuteCommand("eccut");
                end
            end
            ord("A"):
            begin
                if fctl then selectall();
            end
        end
    end
    function WMCHAR(o,e);virtual;//字符
    begin
        if fOnKeyPress then 
        begin
            CallMessgeFunction(fOnKeyPress,o,e); 
            if e.skip then return ;   
        end 
        if fcanundo then fredolist.clear();//清空
        c := e.CharCode;
        case c of
            VK_BACK:
            begin
                return dobackspace();
            end
        end
        if c<32 then return;
        if FReadOnly then return;
        if c .& 0x80 then
        begin
            if FHafChar then
            begin
                InsertChar(FHafChar+e.char);
                FHafChar := "";
            end else
            begin
                FHafChar := e.char;
            end
        end else
        begin
            InsertChar(e.char);
        end 
    end
    function FontChanged(o);override;//字体
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            if _wapi.GetFocus()=FHost.Handle then
            begin
                recreateCarete();
            end else
            begin
                CalcFontSize();
                InvalidateRect(nil,false);
            end
        end
    end
    function Paint(); //绘制
    begin
        if not FVisible then return;
        if not(FHost and FHost.HandleAllocated()and FHost.Canvas.HandleAllocated())then return;
        dc := FHost.Canvas;
        dc.font := font;
        rec := GetEntryRect();
        if FReadOnly then
        begin
            dc.brush.color := freadonlyColor;
            dc.FillRect(rec);
        end
        PaintBorder();
        if PaintPlaceHolder(rec)then return;
        fw := FFontWidth;
        fh := FFontHeight;
        if FSelLength <> 0 then //绘制阴影
        begin
            x1 := FSelBegin-FLeftCharCount-1;
            if FSelLength>0 then
            begin
                x2 := x1+FSelLength;
            end else
            begin
                x2 := x1;
                x1 := x2+FSelLength;
            end
            x1 := max(0,x1);
            x2 := max(0,x2);
            if x2>x1 then
            begin
                bc := dc.brush.color;
                dc.brush.color := fselbkcolor; ////rgb(0,220,220);                
                rcb := rec;
                rcb[0]:= x1 * fw+rec[0];
                rcb[2]:= x2 * fw+rec[0];
                if dh>0 then
                begin
                    rcb[1]+= FCaretY;
                    rcb[3]-= FCaretY;
                end
                dc.FillRect(rcb);
                dc.brush.color := bc;
            end
        end
        if FLeftCharCount>0 then
        begin
            if bytetype(FString,FLeftCharCount)=1 then
            begin
                rec[0]-= fw;
                dstr := FString[FLeftCharCount:];
            end else
            dstr := FString[(FLeftCharCount+1):];
        end else
        dstr := FString;
        PaintText(dstr,rec);
        //dc.drawtext(dstr,rec,DT_VCENTER .| DT_SINGLELINE);      
    end
    function MouseUp(o,e);
    begin
        if not(FHost and FHost.HandleAllocated())then return;
        FMouseLbuttonDown := false;
        _wapi.ClipCursor(0);
    end
    function MouseMove(o,e);
    begin
        if not FVisible then return;
        if not(FHost and FHost.HandleAllocated())then return;
        //move ;
        if not FMouseLbuttonDown then return;
        rec := GetEntryRect();
        x := e.xpos;
        if x<rec[0]+2 then x -= FFontWidth * 3;
        IF X>rec[2]-2 then x += FFontWidth * 3;
        nx := GetCharPosByX(x);
        MoveCaretTo(nx,true);
    end
    function MouseDown(o,e);
    begin
        if not FVisible then return;
        if not(FHost and FHost.HandleAllocated())then return;
        rec := GetEntryRect();
        if not(pointinrect(e.pos,FClientRect))then return;
        if  FIsCaretShow and  e.shiftdouble() then 
        begin
            return selectall();    
        end  
        x := e.xpos;
        if x<rec[2]and x>rec[0]then
        begin
            if e.button()=mbLeft then
            begin
                x := GetCharPosByX(e.xpos);
                MoveCaretTo(x,0);
                FMouseLbuttonDown := true;
                crect := rec;
                if FHost then //固定区域
                begin
                    ps := array(FHost.clienttoscreen(crect[0],crect[1]),FHost.clienttoscreen(crect[2],crect[3]));
                    _wapi.ClipCursor(ps);
                end
            end
            if not FIsCaretShow then return SetFocus();
        end
    end
    function SetFocus(); //设置焦点
    begin
        if not FVisible then return;
        FSetFocused := true;
        if FHost and FHost.HandleAllocated()then
        begin
            if _wapi.GetFocus()<> FHost.Handle then return FHost.SetFocus();
        end
        CreateCaret();
        updatecaret();
        if FFocusBorder then InvalidateRect(nil,false);
        doonsetfocus();
    end
    function KillFocus();//删除焦点
    begin
        FMouseLbuttonDown := false;
        _wapi.ClipCursor(0); //添加输入焦点处理
        FSetFocused := false;
        DestroyCaret();
        if FFocusBorder then InvalidateRect(nil,false);
        doonkillfocus();
    end
    function Recycling();override;
    begin
        FKillFocus := 0;
        FOnSetFocus := 0;
        FPassWordChar := "#";
        FMarked := 0;
        FOnMaxText := 0;
        FOnUpdate := 0;
        FOnChange := 0;
        FOnKeyUp := nil;
        FOnKeyDown := nil;
        fOnKeyPress := nil;
        Fplaceholder := 0;
        FHost := nil;
        FFont := nil;
        inherited;
    end
    property Visible read FVisible write SetVisible;
    property text:string read FString write setEditText;
    property onmaxtext:eventhandler read FOnMaxText write FOnMaxText; //eventhandler 修改
    property placeholder:string read Fplaceholder write Setplaceholder;
    property readonly:bool read FReadOnly write setReadOnly;
    property limitlength:integer read Flimitlength write setLimitLength;
    property LineWrap:bool read FLineWrap write FLineWrap;
    property Border read FBorder write SetBorder;
    property Font read FFont write SetFont;
    property ClientRect read FClientRect write FClientRect; //区域
    property host read FHost write SetHost;
    property HasFocus read FSetFocused;
    property OnKeyPress read FOnKeyPress write FOnKeyPress;
    property OnKeyDown read FOnKeyDown write FOnKeyDown;
    property onkeyup read FOnKeyUp write FOnKeyUp;
    property Focusedborder read FFocusBorder write FFocusBorder;
    private
    fcanundo;
    fredolist;
    fundolist;
    FIsCaretShow;
    FKillFocus;
    FOnSetFocus;
    FPassWordChar;
    FMarked;
    FOnMaxText;
    FOnUpdate;
    FOnChange;
    FOnKeyPress;
    FOnKeyDown;
    FOnKeyUp;
    Fplaceholder;
    FSetFocused;
    FFocusBorder;
    Fplaceholdercolor;
    fselbkcolor;
    freadonlyColor;
    static FCopyer;
    private
    function undo();
    begin
        if not fcanundo then return ;
        it := fundolist.pop();
        if not it then return ;  
        fundolist.lock();        
        try 
            doitem(it);
        except
        
        end;
        case it.freason of 
            "del":it.freason := "ins";
            "ins":it.freason := "del";        
        end ;
        fredolist.AddChange(it);
        fundolist.unlock();
        //if not canundo then return ;
    end 
    function redo();
    begin
        if not fcanundo then return ;
        it := fredolist.pop();
        if not it then return ;
        doitem(it);
        //if not canundo then return ;
    end 
    function doitem(it);
    begin
        case it.freason of 
            "del":
            begin
                s := it.ftext;
                b := it.FStart;
                FCaretX := b;
                InitSel();
                InsertChar(s);    
            end 
            "ins":
            begin
                s := it.ftext;
                b := it.FStart;
                FSelBegin := b;                
                FSelLength := length(s);
                FCaretX := b+FSelLength;
                dodelete();
            end         
        end ;
    end 
end
type tVirtualCalender=class(TSLUIBASE)
    {**
    @explan(说明) 月历控件虚拟类
    **}
    function create();
    begin
        inherited;
        FFont := new Tcustomfont();
        FDateRows := 8;
        FCalenderState := 3;
        FLeft := 0;
        FTop := 0;
        FCellWidth := 30;
        FCellHeight := 16;
        FYear := 2021;
        FMonth := 3;
        FDate := 3;
        FHasMonthSel := true;
        FHasToday := true;
        FTodayHeight := 20;
        FMonthselheight := 25;
        FDateMatrix := array();
        CalcDateMatrx();
    end
    function InvalidateRect(rec,f);
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            FHost.InvalidateRect(rec ?: GetCalenderRect,f);
        end
    end
    function dodatechanged();virtual;
    begin
        if FHost and FHost.HandleAllocated()then
        begin
            FHost.DoDatechanged();
        end
    end
    function ExecuteCommand(cmd,p);
    begin
        case cmd of
            "metodaybutton":
            begin
                if ifnil(p)then return FHasToday;
                else
                begin
                    nv := p?true:false;
                    if FHasToday <> nv then
                    begin
                        FHasToday := nv;
                        CalcDateMatrx();
                        InvalidateRect(nil,false);
                    end
                end
            end
            "mestate":
            begin
                if(p <> FCalenderState)and(p in array(1,2,3))then
                begin
                    FCalenderState := p;
                    CalcDateMatrx();
                    InvalidateRect(nil,false);
                end else
                return FCalenderState;
            end
            "meyear":
            begin
                //设置年 
                if(p>0 or p <= 0)and p <> FYear then
                begin
                    FYear := p;
                    CalcDateMatrx();
                    InvalidateRect(nil,false);
                    dodatechanged();
                end
                return FYear;
            end
            "meminc":
            begin
                d := incmonth(encodedate(FYear,FMonth,FDate),not(p>0 or p<1)?1:(p));
                decodedate(d,y,m,d);
                FYear := y;
                FMonth := max(m,1);
                FDate := max(d,1);
                CalcDateMatrx();
                InvalidateRect(nil,false);
                dodatechanged();
            end
            "memonth":
            begin
                //设置月
                if FMonth <> p and(p>0 or p<13)then
                begin
                    ModifyDate(FYear,p,FDate);
                    FMonth := p;
                    CalcDateMatrx();
                    InvalidateRect(nil,false);
                    dodatechanged();
                end
                return FMonth;
            end
            "meyearmonth":
            begin
                //设置年,月
                if ifarray(p)and ifnumber(p[0])and ifnumber(p[1])then
                begin
                    if p[0]<> FYear or p[1]<> FMonth then
                    begin
                        ExecuteCommand("meymd",encodedate(p[0],p[1],FDate));
                    end
                end
            end
            "medate":
            begin
                if p <> FDate and p>0 and p <= getmonthdates(FYear,FMonth)then
                begin
                    FDate := p;
                    CalcDateMatrx();
                    InvalidateRect(nil,false);
                    dodatechanged();
                end
                return FDate;
            end
            "meymd":
            begin
                if p >= 0 or p<0 then
                begin
                    decodedate(p,y,m,d);
                    if y <> FYear or FMonth <> m or FDate <> d then
                    begin
                        FYear := y;
                        FMonth := m;
                        FDate := d;
                        CalcDateMatrx();
                        InvalidateRect(nil,false);
                        dodatechanged();
                    end
                end else
                return encodedate(FYear,FMonth,FDate);
            end
            "meselbypos":
            begin
                r := ExecuteCommand("megetbypos",p);
                if not r then return;
                if r="today" then
                begin
                    FCalenderState := 3;
                    ExecuteCommand("meymd",date());
                end
                case FCalenderState of
                    3:
                    begin
                        ExecuteCommand("medate",r);
                    end
                    2:
                    begin
                        FCalenderState := 3;
                        m := FMonth;
                        d := FDate;
                        y := FYear;
                        ExecuteCommand("memonth",r);
                        if(m=FMonth)and(d=FDate)and(y := FYear)then
                        begin
                            CalcDateMatrx();
                            InvalidateRect(nil,false);
                        end
                    end
                    1:
                    begin
                        FCalenderState := 2;
                        m := FMonth;
                        d := FDate;
                        y := FYear;
                        ExecuteCommand("meyear",r);
                        if(m=FMonth)and(d=FDate)and(y := FYear)then
                        begin
                            CalcDateMatrx();
                            InvalidateRect(nil,false);
                        end
                    end
                end;
                return r;
            end
            "mestatebypos": //切换状态
            begin
                r := ExecuteCommand("megetstatepos",p);
                ExecuteCommand("mestate",r);
                return r;
            end
            "megetstatepos": //状态改变区域
            begin
                if not(FYearRect and FMonthRect)then return;
                if(p)then
                begin
                    p0 := p[0];
                    p1 := p[1];
                    if not(p0>0 or p0<0)then return;
                    if not(p1>0 or p1<0)then return;
                    x := p0-FLeft;
                    y := p1-FTop;
                    pp := array(x,y);
                    if pointinrect(pp,FYearRect)then return 1;
                    if pointinrect(pp,FMonthRect)then return 2;
                    return 0;
                end
            end
            "megetincpos": //获得month inc month dec 
            begin
                if not(FIncRect and FDecRect)then return;
                if(p)then
                begin
                    p0 := p[0];
                    p1 := p[1];
                    if not(p0>0 or p0<0)then return;
                    if not(p1>0 or p1<0)then return;
                    x := p0-FLeft;
                    y := p1-FTop;
                    pp := array(x,y);
                    if pointinrect(pp,FIncRect)then return 1;
                    if pointinrect(pp,FDecRect)then return -1;
                end
            end
            "megetbypos":
            begin
                if ifarray(p)then
                begin
                    p0 := p[0];
                    p1 := p[1];
                    if not(p0>0 or p0<0)then return;
                    if not(p1>0 or p1<0)then return;
                    x := p0-FLeft;
                    y := p1-FTop-(FHasMonthSel * FMonthselheight);
                    pp := array(x,y);
                    if pointinrect(pp,FTodyRect)then
                    begin
                        return "today";
                    end
                    if FCalenderState=3 then
                    begin
                        for i := 1 to 6 do
                        begin
                            for j := 0 to 6 do
                            begin
                                d := FDateMatrix[i,j];
                                if ifarray(d)then
                                begin
                                    rec := d["rec"];
                                    if pointinrect(pp,rec)then
                                    begin
                                        return d["value"];
                                    end
                                end
                            end
                        end
                    end else
                    if FCalenderState in array(2,1)then
                    begin
                        for i,d in FDateMatrix do
                        begin
                            if ifarray(d)then
                            begin
                                rec := d["rec"];
                                if pointinrect(pp,rec)then
                                begin
                                    return d["value"];
                                end
                            end
                        end
                    end
                end
            end
        end
    end
    function paint();
    begin
        if not(host and host.HandleAllocated())then return;
        dc := host.Canvas;
        if not(dc and dc.HandleAllocated())then return;
        dc.font := font;
        if FHasMonthSel then
        begin
            dc.brush.color := rgb(200,220,220);
            dc.fillrect(array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FMonthselheight));
            if FDecRect then dc.draw("framecontrol",array((FDecRect[0]+FLeft,FDecRect[1]+FTop),(FDecRect[2]+FLeft,FDecRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLLEFT);
            if FIncRect then dc.draw("framecontrol",array((FIncRect[0]+FLeft,FIncRect[1]+FTop),(FIncRect[2]+FLeft,FIncRect[3]+FTop)),DFC_SCROLL,DFCS_SCROLLRIGHT);
            if FYearRect then
            begin
                rec := FYearRect;
                rec[0]+= FLeft;
                rec[2]+= FLeft;
                rec[1]+= FTop;
                rec[3]+= FTop;
                if FCalenderState=1 then
                begin
                    dc.brush.color := rgb(240,240,250);
                    dc.fillrect(rec);
                end
                dc.font.weight := 700;
                dc.drawtext(inttostr(FYear)+"年",rec,DT_CENTER);
            end
            if FMonthRect then
            begin
                rec := FMonthRect;
                rec[0]+= FLeft;
                rec[2]+= FLeft;
                rec[1]+= FTop;
                rec[3]+= FTop;
                if FCalenderState=2 then
                begin
                    dc.brush.color := rgb(240,240,250);
                    dc.fillrect(rec);
                end
                dc.font.weight := 700;
                dc.drawtext(inttostr(FMonth)+"月",rec,DT_CENTER);
            end
        end
        t := FTop+(FMonthselheight * FHasMonthSel);
        if FCalenderState in array(1,2)then
        begin
            for i,d in FDateMatrix do
            begin
                if not ifarray(d)then continue;
                rec := d["rec"];
                if not rec then continue;
                rec[0]+= FLeft;
                rec[2]+= FLeft;
                rec[1]+= t;
                rec[3]+= t;
                if d["sel"]then
                begin
                    dc.brush.color := rgb(200,200,100);
                    dc.FillRect(rec);
                end
                dc.drawtext(d["text"],rec,DT_CENTER .| DT_VCENTER .| DT_SINGLELINE);
            end
        end else
        if FCalenderState=3 then
        begin
            for i := 0 to 6 do
            begin
                for j := 0 to 6 do
                begin
                    d := FDateMatrix[i,j];
                    if not ifarray(d)then continue;
                    rec := d["rec"];
                    if not rec then continue;
                    rec[0]+= FLeft;
                    rec[2]+= FLeft;
                    rec[1]+= t;
                    rec[3]+= t;
                    if d["sel"]then
                    begin
                        dc.brush.color := rgb(200,200,100);
                        dc.FillRect(rec);
                    end
                    if i=0 then dc.font.weight := 700;
                    else dc.font.weight := 400;
                    dc.drawtext(d["text"],rec,DT_CENTER .| DT_VCENTER .| DT_SINGLELINE);
                end
            end
            dc.pen.width := 1;
            dc.pen.color := 0;
            dc.moveto(array(FLeft,t+FCellHeight));
            dc.LineTo(array(FLeft+FCellWidth * 7,t+FCellHeight));
        end
        if FTodyRect then
        begin
            rec := FTodyRect;
            rec[0]+= FLeft;
            rec[2]+= FLeft;
            rec[1]+= t;
            rec[3]+= t;
            dc.brush.color := rgb(200,200,200);
            dc.fillrect(rec);
            dc.drawtext(" today: "+datetimetostr(date()),rec,DT_LEFT);
        end
    end
    function recycling();override;
    begin
        inherited;
        FHost := nil;
        FFont := nil;
    end
    public
    property Left read FLeft write SetLeft;
    property top read FTop write SetTop;
    property host read FHost write sethost;
    property ClientRect read GetCalenderRect;
    private
    function ModifyDate(y,m,d);
    begin
        ct := getmonthdates(y,m);
        if d>ct then d := ct;
    end
    function sethost(h);
    begin
        if host <> h then
        begin
            FHost := h;
        end
    end
    function SetLeft(v);
    begin
        if FLeft <> v then
        begin
            FLeft := integer(v);
            InvalidateRect(nil,false);
        end
    end
    function settop(v);
    begin
        if FTop <> v then
        begin
            FTop := integer(v);
            InvalidateRect(nil,false);
        end
    end
    function GetCalenderRect();
    begin
        return array(FLeft,FTop,FLeft+FCellWidth * 7,FTop+FHasMonthSel * FMonthselheight+FCellHeight * FDateRows+FHasToday * FTodayHeight);
    end
    function CalcDateMatrx();
    begin
        FDecRect := array();
        FIncRect := array();
        FTodyRect := array();
        if FHasMonthSel then
        begin
            FDecRect := array(5,2,25,22);
            x := 7 * FCellWidth-25;
            FIncRect := array(x,2,x+20,22);
            FYearRect := array(60,2,110,22);
            FMonthRect := array(115,2,165,22);
        end
        if FHasToday then
        begin
            x := 7 * FCellWidth;
            y := FDateRows * FCellHeight;
            FTodyRect := array(0,y,x,y+FTodayHeight);
        end
        FDateMatrix := array();
        if FCalenderState=3 then
        begin
            for i,v in array("日","一","二","三","四","五","六") do
            begin
                x0 := i * FCellWidth;
                x1 := x0+FCellWidth;
                y0 := cidx * FCellHeight;
                y1 := y0+FCellHeight;
                data := array();
                data["rec"]:= array(x0,y0,x1,y1);
                data["text"]:= v;
                FDateMatrix[0,i]:= data;
            end
            if FYear>0 and FMonth>0 then
            begin
                ct := getmonthdates(FYear,FMonth);
                cidx := 1;
                for i := 1 to ct do
                begin
                    dt := encodedate(FYear,FMonth,i);
                    dw :=(dayofweek(dt)-1);
                    if i=1 then //之前的
                    begin
                        //上一个月
                    end
                    x0 := dw * FCellWidth;
                    x1 := x0+FCellWidth;
                    y0 := cidx * FCellHeight;
                    y1 := y0+FCellHeight;
                    data := array();
                    data["rec"]:= array(x0,y0,x1,y1);
                    data["text"]:= inttostr(i);
                    data["value"]:= i;
                    data["sel"]:=(FDate=i);
                    FDateMatrix[cidx,dw]:= data;
                    if dw=6 then
                    begin
                        cidx++;
                    end
                    if i=ct then
                    begin
                        //下一个月
                    end
                end
            end
        end else
        if FCalenderState=2 then //月选择
        begin
            cw := integer(FCellWidth * 1.5);
            ch := integer(FCellHeight * 2);
            for i := 1 to 12 do
            begin
                data := array();
                divmod(i-1,4,a,b);
                x0 := b * cw+10;
                x1 := x0+cw;
                y0 := a * ch+10;
                y1 := y0+ch;
                data := array();
                data["rec"]:= array(x0,y0,x1,y1);
                data["text"]:= inttostr(i)+"月";
                data["value"]:= i;
                data["sel"]:=(FMonth=i);
                FDateMatrix[i]:= data;
            end
        end else
        if FCalenderState=1 then //年选择
        begin
            cw := integer(FCellWidth * 1.5);
            ch :=(FCellHeight);
            for i,v in((FYear-13)->(FYear+14)) do
            begin
                data := array();
                divmod(i,4,a,b);
                x0 := b * cw+10;
                x1 := x0+cw;
                y0 := a * ch+10;
                y1 := y0+ch;
                data := array();
                data["rec"]:= array(x0,y0,x1,y1);
                data["text"]:= inttostr(v);
                data["value"]:= v;
                data["sel"]:=(FYear=v);
                FDateMatrix[i]:= data;
            end
        end
    end
    private
    FFont;
    FDateRows;
    FYearRect;
    FMonthRect;
    FCalenderState;
    FTodyRect;
    FHasToday;
    FTodayHeight;
    FIncRect;
    FDecRect;
    FMonthselheight;
    FHasMonthSel;
    FDateMatrix;
    FDate;
    FMonth;
    FYear;
    FHost;
    FLeft;
    FTop;
    FCellWidth;
    FCellHeight;
end
type TcustomLabel = class(TGraphicControl)
    {**
    @explan(说明)标签控件 %%
    **}
    private
    FTextAlign;
    function SetTextAlign(v);
    begin
        if v <> FTextAlign then
        begin
            FTextAlign := v;
            InvalidateRect(nil,true);
        end
    end
    protected
    function SetControlFont(v);override;
    begin
        inherited;
        //invalidaterect(nil,true);
        invalidaterect(nil,false);
    end
    public
    function paint();override;
    begin
        dc := canvas;
        dc.font := font;
        rc := ClientRect;
        if border then
        begin
            rc[0]+= 1;
            rc[1]+= 1;
            rc[2]-= 1;
            rc[3]-= 1;
        end
        CanvasDrawAlignText(dc,rc,self.Caption,FTextAlign);
        if border then
        begin
            dc.Draw("polyline",array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1])));
        end
    end
    function create(AOwner);override;
    begin
        inherited;
        caption := "label";
        FTextAlign := 0;
        //border := true;
    end
    class function CanvasDrawAlignText(dc,rect,txt,al);
    begin
        {**
        @explan(说明) 在指定区域内按照对齐方式绘制文本%%
        @param(al)(member of TAlignStyle9) 对齐方式 %%
        **}
        if not(dc is class(TCustomcanvas))then exit;
        als := array(36,0,33
            ,2,36
            ,37
            ,38,40
            ,41
            ,42);
        val := als[al];
        if ifnil(val)then val := 36;
        return dc.drawtext(txt,rect,val .| DT_NOPREFIX);
    end
    property TextAlign:AlignStyle9 read FTextAlign write SetTextAlign;
    {**
    @param(TextAlign)(member of TAlignStyle9) 文字对齐 %%
    **}
end
type tcustomedit=class(TCustomControl)
    {**
    @explan(说明) 单行文本编辑框类 %%
    **}
    private
    FEditable;
    type TEntryEditable=class(teditable)
        function Create();
        begin
            inherited;
        end
        function doonmaxtext();override;
        begin
            if host then host.doonmaxtext();
        end
        function doOnChange();override;
        begin
            if host then host.DoChanged();
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        Left := 10;
        Top := 10;
        //Ftextalign := 0;
        Width := 80;
        Height := 25;
        FEditable := new TEntryEditable();
        FEditable.host := self(true);
    end 
    function ExecuteCommand(cmd,pm);override;
    begin
        if FEditable then return FEditable.ExecuteCommand(cmd,pm);
    end
    function SetSel(bgid,edid);
    begin
        {**
        @explan(说明)设置选择文本 %%
        @param(bgid)(integer) 开始位置 默认为0 %%
        @param(edid)(integer) 结束位置 默认为整体长度 %%
        **}
        return ExecuteCommand("ecsel",array(bgid+1,edid+1));
    end
    function Paint();override;
    begin
        if FEditable then FEditable.Paint();
    end
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if FEditable then FEditable.MouseUp(o,e);
        inherited;
    end
    function MouseMove(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if FEditable then FEditable.MouseMove(o,e);
        inherited;
    end
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if FEditable then FEditable.MouseDown(o,e);
        inherited;
    end
    function dosetfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if FEditable then
        begin
            FEditable.SetFocus();
        end
        inherited;
    end
    function dokillfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if FEditable then
        begin
            FEditable.killFocus();
        end
        inherited;
    end
    function DoWMSIZE(o,e);override;
    begin
        if FEditable then
        begin
            rc := ClientRect;
            FEditable.ClientRect := rc;
        end
        inherited;
    end
    function keypress(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if FEditable then
        begin
            FEditable.WMCHAR(o,e);
        end
        inherited;
    end
    function KeyDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if FEditable then FEditable.WMKEYDOWN(o,e);
        inherited;
    end
    function doonmaxtext();
    begin
        if FOnMaxText then 
            CallMessgeFunction(FOnMaxText,self(true),new tuieventbase(0,0,0,0));
    end
    function DoChanged();
    begin
        if FOnChange then 
        CallMessgeFunction(FOnChange,self(true),new tuieventbase(0,0,0,0));
        if FOnUpdate then 
        CallMessgeFunction(FOnUpdate,self(true),new tuieventbase(0,0,0,0));
    end
    function FontChanged(sender);override;
    begin
        inherited;
        FEditable.font := Font;
    end
    function Recycling();override;
    begin
        inherited;
        FOnUpdate := nil;
        FOnChange := nil;
        fonmaxtext := nil;
        if FEditable then FEditable.Recycling();
        FEditable := nil;
    end
    property text:string read getentrytext write setentrytext;
    property onmaxtext:eventhandler read Fonmaxtext write fonmaxtext;
    property onupdate read FOnUpdate write FOnUpdate;
    property onchange read FOnChange write FOnChange;
    property readonly:bool read getReadOnly write setReadOnly;
    property limitlength:integer read getlimitlength write setLimitLength;
    property LineWrap:bool read getLineWrap write setLineWrap;
    property placeholder:string read getplaceholder write Setplaceholder;
    property Border:bool read getBorder write SetBorder;
    {**
    @param(LineWrap)(bool)自动换行,默认为false不自动换行%%				
    @param(onmaxtext)(fpointer)达到文本最大回调%%
    @param(onupdate)(fpointer)文本更新回调%%
    @param(onchange)(fpointer)文本改变回调%%
    @param(readonly)(bool)只读%%
    @param(onlimitlength)(integer)设置输入字符的长度%%
    **}
    private
    function getBorder();
    begin
        if FEditable then return FEditable.Border;
    end
    function setBorder(s);override;
    begin
        if FEditable then return FEditable.Border := s;
    end
    function getentrytext();
    begin
        if FEditable then return FEditable.text;
        return "";
    end
    function setentrytext(s);
    begin
        if FEditable then return FEditable.text := s;
    end
    function getplaceholder();
    begin
        if FEditable then return FEditable.placeholder;
    end
    function setplaceholder(v);
    begin
        if FEditable then return FEditable.placeholder := v;
    end
    function getReadOnly();
    begin
        if FEditable then return FEditable.readonly;
    end
    function setReadOnly(v);
    begin
        if FEditable then return FEditable.readonly := v;
    end
    function getlimitlength();
    begin
        if FEditable then return FEditable.limitlength;
    end
    function setLimitLength(n);
    begin
        if FEditable then return FEditable.limitlength := n;
    end
    function getLineWrap();
    begin
        if FEditable then return FEditable.LineWrap;
    end
    function setLineWrap(v);
    begin
        if FEditable then return FEditable.LineWrap := v;
    end
    FOnUpdate;
    FOnChange;
    fonmaxtext;
end
type tcustompassword = class(tcustomedit)          
		{**
				@explan(说明) 密码编辑框类 %%
		**}
    private 
    function SetPassWordChar(v);
    begin
        return ExecuteCommand("ecpasswordchar",v);
    end 
    function getPassWordChar();
    begin
        return ExecuteCommand("ecpasswordchar");
    end 
		  public
    function create(owner);override;
    begin
        inherited;
        ExecuteCommand("ecmarked",true);
        Left := 10;
        Top := 10;
        Width := 80;
        Height := 25; 
        caption := "tpassword";
    end 
    function KeyDown(o,e);override;
    begin
        if ( ssCtrl in e.shiftstate) and  (ord("C")=e.CharCode) then 
        begin
            return ;
        end 
        inherited;    
    end 
    property PassWordChar:string read getPassWordChar write SetPassWordChar;
		
end	
type tthreeEntry=class(TCustomControl)
    private
    type tpickerEditer=class(teditable)
        function Create();
        begin
            inherited;
            border := false;
        end
        function valuemodify();
        begin
            //修改日期
            if host then Host.ExecuteCommand("dtchanged",self);
        end
        fprev;
        fnext;
        protected
        function doonsetfocus();override;
        begin
            ExecuteCommand("ecselall");
        end
        function doonkillfocus();override;
        begin
            valuemodify();
            ExecuteCommand("ecclcsel");
        end
        public
        function GetEntryRect();override;
        begin
            r := ClientRect;
            if not ifarray(r)then return array(0,0,0,0);
            return r;
        end
        function WMCHAR(o,e);override;
        begin
            case e.char of
                "0" to "9":return inherited;
            end;
            case e.CharCode of
                VK_DELETE,VK_BACK:inherited;
            end;
        end
        function WMKEYDOWN(o,e);override;
        begin
            case e.CharCode of
                13:
                begin
                    return valuemodify();
                end
                VK_LEFT:
                begin
                    return GoToPrev();
                end
                VK_RIGHT:
                begin
                    return gotonext();
                end
                VK_UP:
                begin
                    return inc();
                end
                VK_DOWN:
                begin
                    return dec();
                end
            end
            inherited;
        end
        function inc();
        begin
            s := text;
            text := inttostr(strtointdef(s,0)+1);
            valuemodify();
        end
        function dec();
        begin
            s := text;
            text := inttostr(strtointdef(s,0)-1);
            valuemodify();
        end
        private
        function gotonext();
        begin
            valuemodify();
            if fnext then
            begin
                KillFocus();
                fnext.SetFocus();
            end
        end
        function GoToPrev();
        begin
            valuemodify();
            if fprev then
            begin
                KillFocus();
                fprev.SetFocus();
            end
        end
    end
    public
    function create(aowner);
    begin
        inherited;
        
    end
    function AfterConstruction();override;
    begin
        inherited;
        border := true;
        left := 0;
        top := 0;
        height := 24;
        width := 105;
        FFontWidth := font.width;
        //color := rgb(100,100,100);
        FEntrys := array();
        for i := 0 to 2 do
        begin
            o := new tpickerEditer();
            FEntrys[i]:= o;
            o.limitlength := getEntryWidth(i);
        end
        for i := 0 to 2 do
        begin
            FEntrys[i].fnext := FEntrys[(i+1)mod 3];
            FEntrys[(i+1)mod 3].Fprev := FEntrys[i];
        end
        calcCtls();
        FEntrys :: mcell.host := self(true);
    end 
    function paint();override;
    begin
        for i,v in FEntrys do
        begin
            v.paint();
        end
        dc := Canvas;
        for i,v in FSymInfo do
        begin
            if not ifarray(v)then continue;
            dc.drawtext(v["sym"],v["rec"],DT_CENTER .| DT_VCENTER .| DT_SINGLELINE);
        end
        PaintBtn();
    end
    function PaintBtn();virtual;
    begin
        if FBtnRect then
        begin
            dc := Canvas;
            dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN);
        end
    end
    function DoWMSIZE(o,e);override;
    begin
        calcCtls();
        InvalidateRect(nil,false);
        inherited;
    end
    function dosetfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        for i,v in FEntrys do
        begin
            if v.HasFocus then return v.SetFocus();
        end
        for i,v in FEntrys do
        begin
            return v.SetFocus();
        end
        inherited;
    end
    function dokillfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        for i,v in FEntrys do
        begin
            if v.HasFocus then return v.killFocus();
        end
        inherited;
    end
    function keypress(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        for i,v in FEntrys do
        begin
            if v.HasFocus then return v.WMCHAR(o,e);
        end
        inherited;
    end
    function KeyDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        for i,v in FEntrys do
        begin
            if v.HasFocus then return v.WMKEYDOWN(o,e);
        end
        inherited;
    end
    function btnClicked(p);virtual;
    begin
        if pointinrect(p,FBtnRect)then
        begin
            return 1;
        end
    end
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if e.button()=mbLeft then
        begin
            p := e.pos;
            if btnClicked(p)then return;
            for i,v in FEntrys do
            begin
                if v.HasFocus then return v.MouseUp(o,e);
            end
        end
        inherited;
    end
    function MouseMove(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        for i,v in FEntrys do
        begin
            if v.HasFocus then
            begin
                return v.MouseMove(o,e);
            end
        end
        inherited;
    end
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if e.skip then return;
        if e.button()=mbLeft then
        begin
            p := e.pos;
            if pointinrect(p,FBtnRect)then return;
            idx :=-1;
            for i,v in FEntrys do
            begin
                if pointinrect(p,v.GetEntryRect())then
                begin
                    idx := i;
                end else
                v.KillFocus();
            end
            if idx >= 0 then return FEntrys[idx].MouseDown(o,e);
        end
        inherited;
    end
    function recycling();override;
    begin
        inherited;
        For i,v in FEntrys do
        begin
            v.recycling();
        end
        FEntrys := array();
        FSymInfo := array();
    end
    function FontChanged(o);override;
    begin
        //改变
        FFontWidth := font.width;
        for i,v in FEntrys do v.Font := font;
        calcCtls();
    end
    protected
    function calcCtls();virtual;
    begin
        rec := ClientRect;
        h := rec[3]-rec[1];
        wd := rec[2]-rec[0];
        FBtnRect := array(max(0,integer(rec[2]-min(25,h))),rec[1],rec[2]-1,rec[3]-1);
        x := rec[0]+1;
        FSymInfo := array();
        for i,v in FEntrys do
        begin
            nx := x+integer(FFontWidth * (getEntryWidth(i))+2);
            rc := array(x,rec[1],nx,rec[3]);
            v.ClientRect := rc;
            x := nx;
            if i=2 then return;
            nx := x+FFontWidth+1;
            rc := array(x,rec[1],nx,rec[3]);
            FSymInfo[i,"sym"]:= getSym(i);
            FSymInfo[i,"rec"]:= rc;
            x := nx;
        end
    end
    property BtnRect Read FBtnRect;
    property entrys read FEntrys;
    private
    function getEntryWidth(i);virtual;
    begin
        case i of
            0:return 4;
            else return 2;
        end
    end
    function getSym(i);virtual;
    begin
        return "/";
    end
    FSymInfo;
    FBtnRect;
    FFontWidth;
    FEntrys;
end
type TCustomListBoxbase=class(TCustomScrollControl)
    {**
    @explan(说明) listbox基类
    **}
    private
    FItemCount;
    FMaxItemWidth;
    protected /////////////////滚动条相关//////////////////////////////////////////
    function GetClientXCapacity();virtual; //宽度容量
    begin
        r := integer(ClientRect[2]/GetXScrollDelta());
        return r;
    end
    function GetClientYCapacity();virtual; //高度容量
    begin
        return integer(ClientRect[3]/GetYScrollDelta());
    end
    function GetClientXCount();virtual; //宽度间隔
    begin
        return FMaxItemWidth;
    end
    function GetClientYCount();virtual; //高度项
    begin
        return FItemCount-1;
    end
    function GetXScrollDelta();override;
    begin
        return FFontWidth;
    end
    function GetYScrollDelta();override;
    begin
        return FFontHeight+4;
    end
    function PositionChanged();virtual;
    begin
        InvalidateRect(nil,false);
    end
    private
    function PaintLines(FirstLine,LastLine);
    begin
        cvs := Canvas;
        for i := FirstLine to LastLine do
        begin
            rc := GetIdxRect(i);
            PaintIdx(i,rc,cvs);
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        FMaxItemWidth := 1;
        FItemCount := 0;
        FFontHeight := font.Height;
        FFontWidth := font.Width;
        left := 0;
        top := 0;
        height := 100;
        width := 125;
        autoscroll := 1;
        ThumbTrack := true;
        FScroolChanged := false;
    end
    function UpDateScrollBar(); //滚动条改变
    begin
        DoControlAlign();
    end
    function IncPaintLock(); //锁定刷新
    begin
        BeginUpdate();
    end
    function DecPaintLock(); //释放刷新
    begin
        EndUpdate();
    end
    function DoEndUpDate();override; //锁定刷新释放
    begin
        if not(IsUpDating())then
        begin
            if FScroolChanged then
            begin
                FScroolChanged := false;
                return UpDateScrollBar();
            end
        end
        inherited;
    end
    function paint();override;
    begin
        xpos := GetXpos();
        ypos := GetYPos();
        // 计算需要重绘的区域
        ps := PAINTSTRUCT().rcPaint;
        tp := ps[1];
        bo := ps[3];
        FirstLine := integer(max(0,yPos+(tp)/GetYScrollDelta()));
        LastLine := integer(min(FItemCount-1,yPos+(bo)/GetYScrollDelta()));
        cvs := Canvas;
        cvs.Font := font;
        PaintLines(FirstLine,LastLine);
    end
    function MouseUp(o,e);override;
    begin
        if e.Button()=mbLeft then
        begin
            CallMessgeFunction(onclick,o,e);
            e.skip := true;
        end
        
    end
    function MouseDown(o,e);override;
    begin
        if e.Button()=mbLeft and e.shiftdouble()then
        begin
            CallMessgeFunction(ondblclick,o,e);
            e.skip := true;
        end
    end
    function PaintIdx(idx,rc,cvs);virtual;
    begin
        {**
        @explan(说明)绘制项 %%
        @param(idx)(integer) 序号%%
        @param(rc)(array) 绘制区域%%
        @param(cvs)(tcustomcanvas) 画布 %%
        **}
    end
    function InvalidateIdxRect(idx,cnt);virtual;
    begin
        if idx >= 0 and idx<FItemCount then
        begin
            if not(cnt >= 1)then cnt := 1;
            rc := ClientRect;
            y := GetYPos();
            dy := GetYScrollDelta();
            idxtop :=(idx-y) * dy;
            if idxtop >= rc[3]then
            begin
                return;
            end
            if(idxtop+cnt * dy)<= 0 then
            begin
                return;
            end
            rc[1]:= idxtop;
            rc[3]:= min(rc[3],idxtop+cnt * dy);
            InvalidateRect(rc,false);
        end
    end
    function GetIdxByYpos(y);virtual;
    begin
        py := GetYPos();
        r := integer(y/GetYScrollDelta())+py;
        if r >= FItemCount then return -1;
        return r;
    end
    function GetIdxRect(idx);virtual;
    begin
        {**
        @explan(说明)通过序号获得项绘制区域 %%
        @param(idx)(integer) 项序号 %%
        @return(array) array(左上右下) %%
        **}
        if idx >= 0 then
        begin
            rc := ClientRect;
            yp := GetYPos();
            xp := GetXpos();
            DY := GetYScrollDelta();
            rc[1]:=(idx-yp) * DY;
            rc[0]:=(0-xp) * GetXScrollDelta();
            rc[3]:= rc[1]+DY;
            return rc;
        end
        return array();
    end
    function InsureIdxInClient(idx); //确保指定项在区域中
    begin
        {**
        @explan(说明)确保指定项在区域中 %%
        @param(idx)(integer) 项序号 %%    			
        **}
        rc := GetIdxRect(idx);
        c := ClientRect;
        if rc[1]<c[1]then
        begin
            SetYpos(-1+GetYPos()+(rc[1]-c[1])/GetYScrollDelta());
        end else
        if rc[3]>c[3]then
        begin
            SetYpos(1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta());
        end
    end
    function GetClientIdxs();virtual;
    begin
        {**
        @explan(说明)获得客户区项的序号 %%
        @return(array) 序号数组 %%
        **}
        rc := ClientRect;
        r := GetRectIdxs(rc);
        return r[0]-> r[1];
    end
    function doControlALign();override;
    begin
        if(IsUpDating())then
        begin
            FScroolChanged := true;
        end else
        begin
            FMaxItemWidth := GetMaxItemWidth();
            InitialScroll();
        end
    end
    function EnsureIdxVisible(idx);
    begin
        if idx >= FItemCount then idx := FItemCount-1;
        if not(idx >= 0)then return;
        rc := ClientRect;
        idxs := GetRectIdxs(rc);
        if idx <= idxs[0]then
        begin
            SetYpos(idx);
        end else
        if idx >= idxs[1]then
        begin
            ndx := integer((rc[3]-rc[1])/GetYScrollDelta());
            SetYpos(idx-ndx);
        end
    end
    function FontChanged(o);override;
    begin
        wd := font.width;
        h := font.Height;
        if h <> FFontHeight or wd <> FFontWidth then
        begin
            FFontHeight := h;
            FFontWidth := wd;
            UpDateScrollBar();
        end
    end
    function GetItemCount();virtual;
    begin
        return FItemCount;
    end
    property ItemCount read GetItemCount write SetItemCount;
    property ItemHeight read GetYScrollDelta;
    {**
    @param(ItemCount)(integer) 项数量 %%
    **}
    protected
    function SetItemCount(n);
    begin
        if not(n >= 0)then return;
        nn := integer(n);
        if nn <> FItemCount then
        begin
            FItemCount := nn;
            UpDateScrollBar();
        end
    end
    private
    FFontHeight;
    FFontWidth;
    FScroolChanged; //滚动条修改
    function GetRectIdxs(rc);
    begin
        yp := GetYPos();
        tp := rc[1];
        bo := rc[3];
        FirstLine := integer(tp/GetYScrollDelta())+yp;
        LastLine := integer((bo)/GetYScrollDelta())+yp;
        return array(FirstLine,LastLine);
    end
    function GetMaxItemWidth();virtual;
    begin
        return 1;
    end
end
type tlistdrawevent = class(tuieventbase)
{**
    @explan(说明)列表绘制消息对象 %%
    @param(id)(integer) 序号 %%
    @param(rec)(array(左上右下)) 区域 %%
    @param(sel)(bool) 选择状态 %%
    @param(canvas)(TCanvas) 画布 %%
**}
    function create(i,s,r,c);
    begin
        inherited create(0,0,0,0);
        idx := i;
        sel := s;
        rec := r;
        Canvas := c;        
    end 
    rec;
    idx;
    sel;
    canvas;
end 
type TcustomListBox=class(TCustomListBoxbase)
    {**
    @explan(说明) listbox控件 %%
    **}
    private 
    FListitemheigt;
    protected
    function GetYScrollDelta();override;
    begin
        if ownerdraw and FListitemheigt>0 then 
        begin 
            return FListitemheigt;
        end else return inherited;
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        FOwnerDraw := false;
        border := true;
        FitemData := new tnumindexarray();
        FSelBegin :=-1;
        FSelEnd :=-1;
        FMultisel := false;
        fcheckbox := false;
        fselbkcolor := 0xFFE7CB;
    end
    function FontChanged(o);override;
    begin
        if fownerdraw then return ;
        return inherited;
    end 
    function MouseUp(o,e);override;
    begin
        if FIsMouseDown then //已经按下过
        begin
            _wapi.clipcursor(ps);  //解锁光标
            FIsMouseDown := false;
            selchange := 0;
            case FMultisel of
                0:
                begin
                    selchange := FFormerSelBegin <> FSelBegin;
                end
                1:
                begin
                    selchange :=((FFormerSelBegin <> FSelBegin)or(FFormerSelEnd <> FSelEnd))and((FFormerSelBegin <> FSelEnd)or(FFormerSelEnd <> FSelBegin));
                end
                2:
                begin
                    selchange := 1;
                end
            end;
            if selchange then CallMessgeFunction(FselectionChange,o,e);
        end
        inherited;
    end
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if(e.Button()=mbLeft)and not(e.shiftdouble())then
        begin
            FFormerSelBegin := FSelBegin;
            FFormerSelEnd := FSelEnd;
            idx := GetIdxByYpos(e.ypos);
            IncPaintLock();
            if FMultisel=2 then
            begin
                if FMultisel3Data[idx]then Reindex(FMultisel3Data,array(idx:nil));
                else FMultisel3Data[idx]:= not FMultisel3Data[idx];
                InvalidateIdxRect(idx);
            end else
            if idx <> FSelBegin and idx <> FSelEnd then
            begin
                SelRange(false);
                FSelBegin := FSelEnd := idx;
                SelRange(true);
            end
            DecPaintLock();
            FIsMouseDown := true;
            crect := ClientRect;
            ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
            _wapi.clipcursor(ps);
        end else
        FIsMouseDown := false;
        inherited;
    end
    function MouseMove(o,e);override;
    begin
        if FIsMouseDown then
        begin
            rc := ClientRect;
            y := e.ypos;
            dy := GetYScrollDelta();
            if y>rc[3]-4 then
            begin
                y += dy;
            end else
            if y<4 then
            begin
                y -= dy;
            end
            idx := GetIdxByYpos(y);
            if idx<0 then return;
            if FMultisel=2 then
            begin
            end else
            if idx <> FSelEnd then
            begin
                IncPaintLock();
                SelRange(false);
                if FMultisel=1 then FSelEnd := idx;
                else
                begin
                    FSelBegin := FSelEnd := idx;
                end
                SelRange(true);
                DecPaintLock();
            end
            EnsureIdxVisible(idx);
        end
    end
    function PaintIdx(idx,rc,cvs);virtual;
    begin
        {**
        @explan(说明)绘制项 %%
        @param(item)(TCustomListItem) 项 %%
        @param(rc)(array) 绘制区域%%
        @param(cvs)(tcustomcanvas) 画布 %%
        **}
        r := PaintIdxBkg(idx,rc,cvs);
        rc1 := rc;
        rc1[4]:=r;
        if fcheckbox then 
        begin           
            h := rc[3]-rc[1];
            nh := min(h,16);
            nnh := integer((h-nh)/2); 
            rc2 := array(rc[0]+2,rc[1]+nnh,rc[0]+nh+2,rc[3]-nnh);
            cvs.Draw("framecontrol",array(rc2[0:1],rc2[2:3]),DFC_BUTTON,(r)?DFCS_CHECKED:DFCS_BUTTONCHECK);           
            rc1[0]+=nh+5;              
        end
        PaintIdexText(idx,rc1,cvs);
    end
    function PaintIdexText(idx,rc,cvs);virtual;
    begin
        if fownerdraw and Fondrawlist then 
        begin
            e := new tlistdrawevent(idx,rc[4],rc,cvs);
            CallMessgeFunction(Fondrawlist,self(true),e);
            return ;
        end 
        cvs.DrawText(getItemText(idx),rc,DT_NOPREFIX);
    end
    function getCurrentSelection();virtual;
    begin
        {**
        @explan(说明)获取当前选中项的索引，仅用于单选的列表框%%
        **}
        case FMultisel of 
            0:      //单选
            begin
                return  FSelBegin;
            end 
            1:  //连续选择
            begin
                return array(FSelBegin,FSelEnd);    
            end 
            2:   //间断选择
            begin
                r := array();
                rl := 0;
                for i,v in FMultisel3Data do 
                begin
                    if v then 
                    begin
                        r[rl] := i;
                        rl++;
                    end 
                end 
                return r;
            end         
        end 
        return -1;
    end
    function setCurrentSelection(n);virtual;
    begin
        {**
        @explan(说明)设置当前选中项的索引，仅用于单选的列表框%%
        @param(n)(integer)%%
        **}
        if FMultisel=1 then
        begin
            flg := false;
            if isValidIndex(n)then
            begin
                if FSelBegin=n then return ;
                FSelBegin := FSelEnd := n;
                flg := true;
                
            end else
            if ifarray(n) and isValidIndex(n[1])and isValidIndex(n[0])then
            begin
                n1 := MinValue(n);
                n2 := MaxValue(n);
                if n1<>FSelBegin or n2<>FSelEnd then 
                begin 
                    FSelBegin := n1;
                    FSelEnd := n2;
                    flg := true;
                end 
            end
            if flg then 
            begin            
                InvalidateRect(nil,false);
                if FselectionChange then 
                    CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
            end 
            return;
        end else
        if FMultisel=2 then
        begin
            FMultisel3Data2 := array();
            if isValidIndex(n)then
            begin
                FMultisel3Data2[n]:= true;
            end else
            if ifarray(n)then
            begin
                for i,v in n do
                begin
                    if isValidIndex(v)then
                    begin
                        FMultisel3Data2[v]:= true;
                    end
                end
            end
            if FMultisel3Data2<>FMultisel3Data then 
            begin
                FMultisel3Data := FMultisel3Data2;
                InvalidateRect(nil,false);
                if FselectionChange then 
                    CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
            end 
            return;
        end
        if not(isValidIndex2(n)) or n=FSelBegin then return;
        SelRange(false);
        FSelBegin := FSelEnd := n;
        SelRange(true);
        SetYpos(n);
        if FselectionChange then 
            CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
    end
    function getItemSelectedState(n);
    begin
        {**
        @explan(说明)获取指定项的选中状态%%
        @param(n)(integer)指定项下标%%
        @return(bool)是否被选中%%
        **}
        if not isValidIndex(n)then return nil;
        case FMultisel of
            0:
            begin
                return n=FSelBegin;
            end
            1:
            begin
                if FSelBegin <= FSelEnd then return n >= FSelBegin and n <= FSelEnd;
                return n >= FSelEnd and n <= FSelBegin;
            end
            2:
            begin
                return FMultisel3Data[n]=1;
            end
        end
        return nil;
    end
    function setItemSelectedState(n,state);
    begin
        {**
        @explan(说明)设置指定项选中状态，仅用于非连续多选的列表框%%
        @param(n)(integer)指定项索引%%
        @param(state)(bool)状态%%
        **}
        b := state?1:0;
        if (FMultisel <> 2) or not(isValidIndex(n)) or (b=getItemSelectedState(n)) then return;
        if b then FMultisel3Data[n]:= b;
        else 
        begin
            reindex(FMultisel3Data,array(n:nil));
        end 
        if FselectionChange then 
            CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
        InvalidateIdxRect(n);
    end
    function appendItem(item);virtual;
    begin
        {**
        @explan(说明)在列表框最后添加一个项%%
        @param(item)(string)要添加的字符串%%
        @return(integer)所添加项在列表框中的索引%%
        **}
        if CheckListItem(item)then
        begin
            FitemData.Push(item);
            class(TCustomListBoxbase).ItemCount := FitemData.length();
            return ItemCount-1;
        end
        return -1;
    end
    function appendItems(ari);virtual;
    begin
        {**
        @explan(说明)在列表框最后添加多个项%%
        @param(ari)(array)要添加的字符串组成的数组%%
        @return(integer)所添加的最后一项在列表框中的索引%%
        **}
        if CheckListItems(ari)then
        begin
            FitemData.Pushs(ari);
            inherited SetItemCount(FitemData.length());
            //class(TCustomListBoxbase).ItemCount := ;
            return ItemCount-1;
        end
        return -1;
    end
    function insertItem(item,n);virtual;
    begin
        {**
        @explan(说明)在指定索引处插入一项%%
        @param(item)(string)插入的字符串%%
        @param(n)(integer)指定下标索引%%
        @return(integer)返回插入的字符串的下标，出错则返回-1%%
        **}
        if ifnil(n)then return appendItem(item);
        if FitemData.Length()<1 then return appendItem(item);
        if isValidIndex(n)and CheckListItem(item)then
        begin
            SelectedChangeSwitch(n,1,1);
            FitemData.splice(n,0,item);
            class(TCustomListBoxbase).ItemCount := FitemData.length();
            return n;
        end
        return -1;
    end
    function insertItems(ari,n);virtual;
    begin
        {**
        @explan(说明)在指定索引处插入多个项，将该函数用于多选列表框将会导致所有选择项丢失%%
        @param(ari)(array of string)插入项组成的数组%%
        @param(n)(integer)指定下标索引，缺省则插至末尾%%
        @return(integer)返回插入的最后的字符串的下标，出错则返回-1%%
        **}
        if ifnil(n)then return appendItems(ari);
        if FitemData.Length()<1 then return appendItems(item);
        if CheckListItems(ari)and isValidIndex(n)then
        begin
            SelectedChangeSwitch(n,length(ari),1);
            FitemData.splices(n,0,ari);
            class(TCustomListBoxbase).ItemCount := FitemData.length();
            return n+length(ari)-1;
        end else
        return -1;
    end
    function deleteItem(n);override;
    begin
        {**
        @explan(说明)删除指定的合法下标索引的项%%
        @param(n)(integer)指定项下标索引%%
        @return(integer)剩余的项的数量，出错则返回-1%%
        **}
        if not isValidIndex(n)then return-1;
        SelectedChangeSwitch(n,1,0);
        FitemData.splice(n,1);
        class(TCustomListBoxbase).ItemCount := FitemData.length();
        return FitemData.Length();
    end
    function deleteItems(n,cnt);
    begin
        {**
        @explan(说明)删除指定的合法下标处开始多个项%%
        @param(n)(integer)指定项下标索引%%
        @param(cnt)(integer)删除项数，当删除的项超过尾项时，删至尾项%%
        @return(integer)剩余的项的数量，出错则返回-1%%
        **}
        if not isValidIndex(n)or cnt <= 0 then return-1;
        SelectedChangeSwitch(n,cnt,0);
        FitemData.splice(n,cnt);
        class(TCustomListBoxbase).ItemCount := FitemData.length();
        return FitemData.Length();
    end
    function DeleteSelectedItems();
    begin
        {**
        @explan(说明) 删除选中的项目 %%
        **}
        if FMultisel=2 then
        begin
            if FMultisel3Data then
            begin
                r := array();
                ri := 0;
                for i := 0 to FitemData.length()-1 do if not FMultisel3Data[i]then r[ri++]:= FitemData[i];
                setdata(r);
            end
        end else
        begin
            if FSelBegin >= 0 and FSelEnd >= FSelBegin then deleteItems(const FSelBegin,FSelEnd-FSelBegin+1);
        end
    end

    function setData(ari);virtual;
    begin
        IncPaintLock();
        Clean();
        AppendItems(ari);
        DecPaintLock();
    end
    function getSelectedIndexes();virtual;
    begin
        {**
        @explan(说明)获取列表框内当前选中项的索引组成的数组%%
        @return(array)当未选中任何项时，返回空数组%%
        **}
        r := array();
        case FMultisel of
            0:
            begin
                return FSelBegin=-1?r:array(FSelBegin);
            end
            1:
            begin
                if FSelBegin<0 then return r;
                if FSelBegin <= FSelEnd then return FSelBegin -> FSelEnd;
                else return FSelEnd -> FSelBegin;
            end
            2:
            begin
                ri := 0;
                for i,v in FMultisel3Data do r[ri++]:= i;
                return r;
            end
        end
    end
    function getItem(n);
    begin
        {**
        @explan(说明)获取指定项%%
        @param(n)(integer)指定项下标%%
        @return()指定项%%
        **}
        return FitemData[n];
    end
    function getItemText(i);virtual;
    begin
        {**
        @explan(说明) 获得item的文本 %%
        @param(i)(integer) 序号 %%
        @return(string) 项显示字符串 %%
        **}
        r := FitemData[i];
        if ifstring(r)then return r;
        return "";
    end
    function clean();virtual;
    begin
        FitemData.splice(0,FitemData.Length());
        cleanAllSelectedState();
        class(TCustomListBoxbase).ItemCount := 0;
    end
    function Recycling();override;
    begin
        FselectionChange := nil;
        Fondrawlist := nil;
        return inherited;
    end
    property ItemHeight:integer read GetYScrollDelta write setItemHeight;
    property ItemCount:integer read GetItemCount write SetItemCount;
    property Multisel:bool read FMultisel write SetMultisel;
    property checkbox:bool read fcheckbox write setcheckbox;
    property onSelectionChange read FselectionChange write FselectionChange;
    property selbkcolor:color read fselbkcolor write setselbkcolor;
    property onSelchanged:eventhandler read FselectionChange write FselectionChange;
    property ondrawlist:eventhandler read Fondrawlist write Fondrawlist;
    property Items:strings read GetData write setData;
    property itemindex:tsl read getCurrentSelection write setCurrentSelection;
    property ownerdraw:bool read fownerdraw write setownerdraw;
    
    protected
    function CheckListItems(s);
    begin
        if ifarray(s)then
        begin
            for i := 0 to length(s)-1 do if not CheckListItem(s[i])then return 0;
            return 1;
        end else
        return 0;
    end
    function CheckListItem(s);virtual;
    begin
        {**
        @explan(说明) 项检查,重写该方法可以控制项的类型 %%
        **}
        return true;
        //return ifstring(s);
    end
    function isValidIndex(n);
    begin
        return(n >= 0)and n<FitemData.length();
    end
    function isValidIndex2(n);
    begin
        return(n >= -1)and n<FitemData.length();
    end
    FitemData;
    {**
    @explan(说明)(TMyarrayB) list数据数据,不要试图修改该变量
    **}
    private
    function setItemHeight(h);
    begin
        if h>0 and h<>FListitemheigt then 
        begin
            FListitemheigt := integer(h);
            if FOwnerDraw then 
            begin 
                doControlALign();
                InvalidateRect(nil,false);
            end 
        end 
    end 
    function setselbkcolor(v);
    begin
        if (v>0 or v<0) and v<>fselbkcolor then 
        begin
            fselbkcolor := v;
        end 
    end 
    function SetItemCount(n);
    begin
        if fownerdraw and (n>=0) and ItemCount<>n then 
        begin
            d := nils(n);
            setData(d);    
        end 
    end 
    function setownerdraw(v);
    begin
        nv := v?true:false;
        if FOwnerDraw<>nv then 
        begin
            FOwnerDraw := nv;
            if not(FListitemheigt>0) then 
            begin
                FListitemheigt := font.Height+4;
            end 
        end 
    end 
    function PaintIdxBkg(idx,rc,cvs);
    begin
        if(idx >= min(FSelBegin,FSelEnd)and idx <= max(FSelBegin,FSelEnd))or(FMultisel=2 and FMultisel3Data[idx])then
        begin
            r := true;
            cvs.brush.Color := fselbkcolor;//0xFFE7CB;//rgb(204,231,255);
            cvs.FillRect(rc);
        end 
        return r;
    end
    function setcheckbox(c);
    begin
        nc := c?true:false;
        if nc<>fcheckbox then 
        begin
            fcheckbox := nc;
            InvalidateRect(nil,false);
        end 
    end 
    function SetMultisel(n);
    begin
        if n <> FMultisel and(n in array(0,1,2))then
        begin
            SelRange(false);
            FSelBegin := FSelEnd :=-1;
            if n=2 then
            begin
                FMultisel3Data := array();
            end
            FMultisel := n;
        end
    end
    function GetData();
    begin
        return FitemData.Data;
    end

    function SelRange(sel);
    begin
        if FSelBegin >= 0 and FSelEnd >= 0 then
        begin
            InvalidateIdxRect(min(FSelBegin,FSelEnd),abs(FSelBegin-FSelEnd)+1);
        end
    end
    function SelectedChangeSwitch(idx,cnt,isAdd);
    begin
        case FMultisel of
            0:
            begin
                SelectedChange(idx,cnt,isAdd);
            end
            1:
            begin
                cleanAllSelectedState();
            end
            2:
            begin
                MultiSelectedChange(idx,cnt,isAdd);
            end
        end;
    end
    function SelectedChange(idx,cnt,isAdd);
    begin
        //单选列表框在列表框项数增加或者删除时处理选中项的变动
        //idx	增删开始处索引
        //cnt	元素数量
        //isAdd	1：添加，0：删除
        if FSelBegin<idx then return;
        selchange := 0;
        if isAdd then
        begin
            t := FSelBegin+cnt;
        end else
        begin
            if FSelBegin >= idx+cnt then t := FSelBegin-cnt;
            else
            begin
                t :=-1;
                selchange := 1;
            end
        end
        FSelBegin := FSelEnd := t;
        if selchange then CallMessgeFunction(FselectionChange,self(true),nil);
    end
    function MultiSelectedChange(idx,cnt,isAdd);
    begin
        //非连续的多选类型在列表框项数增加或者删除时处理选中项的变动
        //idx	增删开始处索引
        //cnt	元素数量
        //isAdd	1：添加，0：删除
        d := array();
        if isAdd then
        begin
            for i,v in FMultisel3Data do if v then d[i >= idx?i+cnt:i]:= 1;
        end else
        begin
            selchange := 0;
            back := idx+cnt;
            for i,v in FMultisel3Data do if v then
            begin
                if i<idx then d[i]:= 1;
                else if i >= back then d[i-cnt]:= 1;
                else selchange := 1;
            end
        end
        FMultisel3Data := d;
        if selchange then CallMessgeFunction(FselectionChange,self(true),nil);
    end
    function cleanAllSelectedState();
    begin
        selchange := 0;
        if FMultisel=2 then
        begin
            for i,v in FMultisel3Data do if v then selchange := 1;
            FMultisel3Data := array();
        end else
        begin
            if FSelBegin <>-1 then selchange := 1;
            FSelBegin := FSelEnd :=-1;
            FFormerSelBegin := FFormerSelEnd :=-1;
        end
        if selchange then CallMessgeFunction(FselectionChange,self(true),nil);
    end
    private 
    fselbkcolor;
    FOwnerDraw;
    // FselectionCancel;
    FselectionChange;
    Fondrawlist;
    FSelBegin;
    FSelEnd;
    FIsMouseDown;
    FMultisel;
    fcheckbox;
    FMultisel3Data;
    FFormerSelBegin;
    FFormerSelEnd;
end
type TCustomComboBoxbase=class(TCustomControl)
    {**
    @explan(说明) combox 基类 %%
    **}
    function Create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        FBtnWidth := 20;
        FmaxListItemShow := 10;
        FScreenRect := _wapi.GetScreenRect();
        FListBox := CreateAlist();
        if FListBox is class(TWinControl)then
        begin
            FListBox.OnClose := function(o,e)
            begin
                e.skip := true;
                o.Visible := false;
            end
        end
        SetBoundsRect(array(0,0,100,23));
    end 
    function CreateAlist();virtual;
    begin
        {**
        @expaln(说明) 构造一个弹出框 %%
        @return(twincontrol) 弹出窗口 %%
        **}
        return "";
    end
    function Paint();override;
    begin
        rc := ClientRect;
        FBtnRect := rc;
        dc := canvas;
        FBtnRect[0]:= FBtnRect[2]-FBtnWidth;
        dc.Draw("framecontrol",array(FBtnRect[0:1],FBtnRect[2:3]),DFC_SCROLL,1);
    end
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        x := e.xpos;
        y := e.ypos;
        if x>FBtnRect[0]and x<FBtnRect[2]and y>FBtnRect[1]and y<FBtnRect[3]then
        begin
            ShowDropDown(true);
        end
    end
    function ShowDropDown(flg);
    begin
        {**
        @explan(说明)展开或者关闭下拉框%%
        @param(f)(bool)true 展开  false 关闭%%
        **}
        if not((FListBox is class(TWincontrol))and FListBox.WsPopUp)then return;
        if flg and not(FListBox.Visible)then
        begin
            if Fondropdown then 
            begin 
                e := new tuieventbase(0,0,0,0);
                CallMessgeFunction(Fondropdown,self(true),e);
            end 
            SetListBoxRect();
            FListBox.OnActivate := thisfunction(ListActivate);
            FListBox.show(5);
            
        end else
        if not(flg) and FListBox.Visible then
        begin
            if Foncloseup then 
            begin 
                e := new tuieventbase(0,0,0,0);
                CallMessgeFunction(Foncloseup,self(true),e);
            end 
            FListBox.Visible := false;
            
        end
    end
    function Recycling();override;
    begin
        FListBox := nil;
        FOnSelchanged := nil;
        Foncloseup := nil;
        Fondropdown := nil;
        inherited;
    end
    published
    property ItemIndex:tsl read GetItemIndex write SetItemIndex;
    property OnSelchanged:eventhandler read FOnSelchanged write FOnSelchanged;
    property ondropdown:eventhandler read Fondropdown write Fondropdown;
    property oncloseup:eventhandler read Foncloseup write Foncloseup;
    property BtnWidth read FBtnWidth write SetBtnWidth;
    property dropdowncount:integer read FmaxListItemShow write SetmaxListItemShow;
    {**
    @param(ItemIndex)(integer)设置当前项序号%%
    @param(dropdowncount)(integer)下拉列表项数%%
    @param(ondropdown)(function[tcomboBox,tuieventbase])下拉框展开回调%%
    @param(oncloseup)(function[tcomboBox,tuieventbase])下拉框关闭回调%%
    @param(onselchanged)(function[tcomboBox,tuieventbase])当前选项改变回调%%
    @param(FListBox)(twinControl) 弹出框 %%
    **}
    function ListActivate(o,e);
    begin
        if o.visible and e.wparam=0 then
        begin
            ShowDropDown(false);
        end
    end
    protected
    function SetListBoxRect();virtual;
    begin
        {**
        @explan(说明) 设置弹出框的显示区域 %%
        **}
        if not(FListBox is class(TWinControl))then return;
        rc := ClientRect;
        FListbox.height :=  getlistitemheight()* (min(max(0,getlistitemcount()),FmaxListItemShow))+10;
        nrc := ClientToScreen(rc[0],rc[3]);
        if FScreenRect[3]-nrc[1]<250 then
        begin
            nrc[2]:= width+nrc[0];
            nrc[3]:= nrc[1]-height;
            nrc[1]:= nrc[3]-FListBox.Height;
        end else
        begin
            nrc[2]:= width+nrc[0];
            nrc[3]:= FListBox.Height+nrc[1];
        end
        FListBox.SetBoundsRect(nrc);
    end
    FListBox;
    private
    FmaxListItemShow;
    FScreenRect; //桌面区域
    FBtnRect; //按钮区域
    FOnSelchanged; //选择改变
    Fondropdown; //下拉
    Foncloseup; //收起
    FBtnWidth;
    function SetmaxListItemShow(v);//显示项目数量
    begin
        if v>0 then
        begin
            nv := integer(v);
            if nv <> FmaxListItemShow then
            begin
                FmaxListItemShow := nv;
            end
        end
    end
    function SetBtnWidth(n);//按钮宽度
    begin
        if not(n>10 and n<100)then return;
        nn := int(n);
        if nn <> FBtnWidth then
        begin
            SetBtnWidth := nn;
            InValidateRect(nil,false);
            DoControlAlign();
        end
    end
    function getlistitemcount();virtual; //获得项目
    begin
        return 0;
    end 
    function getlistitemheight();virtual; //获得项目高
    begin
        return 20;
    end 
    function GetItemIndex();virtual;//获得选中的序号
    begin
        return -1;        
    end
    function SetItemIndex();virtual;//设置选中的序号
    begin
    end
end
type TcustomComboBox=class(TCustomComboBoxbase)
    {**
    @explan(说明) comboBox下拉框 %%
    **}
    private
    type TComboListBox=class(TcustomListBox)
        function Create(AOwner);
        begin
            inherited;
            caption := "combox list box";
        end
        function MouseUp(o,e);override;
        begin
            inherited;
            visible := false;
        end
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        fmultisel := false;
        fcheckbox := false;
        FEdit := new TcustomEdit(self);
        FEdit.OnKeyDown := function(o,e)
        begin
            if FMultisel then return ;
            case e.charcode of
                VK_UP:
                begin
                    ItemIndex -= 1;
                    e.skip := true;
                end
                VK_DOWN:
                begin
                    ItemIndex += 1;
                    e.skip := true;
                end
            end;
        end
        FEdit.onchange := function(o,e);
        begin
            if feditischanging then return feditischanging := false;
            if not(o.Readonly) then
            begin
                feditischanging := true;
                if Foneditchanged then 
                    CallMessgeFunction(Foneditchanged,o,e);                
                if FMultisel then return feditischanging:=false;
                t := o.Text;
                if t = getCurrentItemText() then return ;                
                for i,v in items do 
                begin
                    if t = v then 
                    begin
                        ItemIndex := i;
                        feditischanging := false;
                        return ;
                    end 
                end 
                ItemIndex := -1;
                feditischanging := false;
            end
        end
        FEdit.onupdate := function(o,e);
        begin
            if not(o.Readonly) then
            begin
                CallMessgeFunction(FoneditUpdate,o,e);
            end
        end
        Freadonly := true;
        FListBox.Border := true;
        FListBox.Visible := false;
        FListBox.WsPopUp := true;
        FListBox.onselchanged := function(o,e);
        begin
            if feditischanging then return ;
            r := getCurrentItemText(); 
            feditischanging := true;
            FEdit.Text := r;   
            feditischanging := false;            
            ShowDropDown(false);
            CallMessgeFunction(OnSelchanged,self(true),e);
        end
        FEdit.Readonly := Freadonly;
        FListBox.parent := self;
        FEdit.parent := self;
    end
    function CreateAlist();override;
    begin
        r := new TComboListBox(self);
        return r;
    end
    function SetDesigning(Value,SetChildren);override;
    begin
        inherited;
        if FEdit then FEdit.Enabled := not Value;
    end
    function DoControlAlign();override;
    begin
        rc := ClientRect;
        rc[2]-= 20;
        FEdit.SetBoundsRect(rc);
    end
    function appendItem(str);virtual;
    begin
        {**
        @explan(说明)添加子项数据%%
        @param(str)(string) 子项字符串%%
        **}
        FListBox.appendItem(str);
    end
    function AppendItems(arr);virtual;
    begin
        {**
        @explan(说明)添加子项数据%%
        @param(arr)(array of string) 子项字符串数组%%
        **}
        FListBox.appendItems(arr);
    end
    function insertItem(str,i);virtual;
    begin
        {**
        @explan(说明)插入子项 %%
        @param(str)(string) 显示标题 %%
        @param(i)(integer) 在i前插入子项 %%
        **}
        FListBox.insertItem(str,i);
    end
    function deleteItem(i);virtual;
    begin
        {**
        @explan(说明)删除子项 %%
        @param(i)(integer) 删除子项的位置 %%
        **}
        FListBox.deleteItem(i);
    end
    function clean()
    begin
        {**
        @explan(说明)清空数据 %%
        **}
        FListBox.Clean();
    end
    function getitems();
    begin
        {**
        @explan(说明)获得所有数据 %%
        @return(array of string) 字符串项 %%
        **}
        return FListBox.items();
    end
    function GetItem(n);
    begin
        return FListBox.GetItem(n);
    end
    function getItemCount();
    begin
        {**
        @explan(说明)统计子项个数 %%
        @return(integer)子项个数 %%
        **}
        //return _send_(CB_GETCOUNT,0,0);
        return FListBox.ItemCount;
    end
    function getItemText(i);
    begin
        {**
        @explan(说明)获取第i个子项的内容 %%
        @param(i)(integer) 子项的位置 %%
        @return(string) 子项标题 %%
        **}
        return FListBox.getItemText(i);
    end
    function getCurrentItemText();
    begin
        {**
        @explan(说明)获取选中的子项字符串 %%
        @return(string) 子项字符串 %%
        **}
        idx := FListBox.GetCurrentSelection();
        if FMultisel then 
        begin 
            r := "";
            for i,v in idx do 
            begin
                r+=getItemText(v)+";";                  
            end 
            if r then r[length(r):]:="";
            return r; 
        end 
        return getItemText(idx);
    end
    property readonly:bool read Freadonly write setReadOnly;
    property Multisel:bool read fmultisel write setMultisel;
    property checkbox:bool read fcheckbox write setcheckbox;
    property textheight read FTextHeight Write FTextHeight;
    property itemheight read FItemHeight write FItemHeight;
    property items:strings read Getitems write setItems;
    property oneditchanged:eventhandler read Foneditchanged write Foneditchanged;
    property onEditUpdate:eventhandler read FoneditUpdate write FoneditUpdate;
    property onkillfocus read Fonkillfocus write Fonkillfocus;
    property onsetfocus read Fonsetfocus write Fonsetfocus;
    property Editer read FEdit;
    {**
    @param(oneditchanged)(function[tcomboBox,tuieventbase])文本被改变回调,文本显示后调用%%
    **}

    private
    function setMultisel(v);
    begin
        nv := v?true:false;
        if nv<>FMultisel then 
        begin
            FMultisel := nv;
            if FMultisel then 
            begin
                FListBox.Multisel := 2;    
            end else 
            begin
                FListBox.Multisel := 0;    
            end 
        end 
    end 
    function setcheckbox(v);
    begin
        nv := v?true:false;
        if nv<>fcheckbox then 
        begin
            fcheckbox := nv;
            FListBox.checkbox := nv;
        end 
    end 
    function setReadOnly(v);
    begin
        nv := v?true:false;
        if nv <> Freadonly then
        begin
            Freadonly := nv;
            FEdit.Readonly := nv;
        end
    end
    function getlistitemcount();override; //获得项目
    begin
        return FListBox.ItemCount;
    end 
    function getlistitemheight();override; //获得项目高
    begin
        return FListBox.ItemHeight;
    end 
    function GetItemIndex();override;
    begin
        //if FMultisel and (csDesigning in ComponentState) then return -1;
        return FListBox.GetCurrentSelection();
    end
    function SetItemIndex(idx);override;
    begin
        //if FMultisel and (csDesigning in ComponentState) then return -1;
        return FListBox.SetCurrentSelection(idx);
    end
    feditischanging;//改变正在回调
    fmultisel;
    fcheckbox;
    FTextHeight;
    FItemHeight;
    Freadonly;
    Foneditchanged;
    FoneditUpdate;
    Fonkillfocus;
    Fonsetfocus;
    FEdit;
    function setItems(d);
    begin
        return FListBox.SetData(d);
    end
end
type tcustommenubutton = class()//菜单按钮
    function create(mu,tb);
    begin
        fmenu := mu;
        fParent := tb;
    end 
    function DoOnClick(o,e); //点击
    begin
        if fParent.HandleAllocated() and  (fmenu is class(TcustomMenu)) then 
        begin
            if fmenu.ItemCount>0 then  //弹出菜单处理
            begin 
                fParent.PopupMenu := fmenu;
                rec := GetRect();
                xy := fParent.clienttoscreen(rec[0],rec[3]);
                uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
                fParent._wapi.TrackPopupMenu(fmenu.Handle,uf,xy[0],xy[1],0,fParent.Handle,nil);
                return ;
            end  //图片点击处理
            CallMessgeFunction(fmenu.OnClick,fmenu,e);
        end 
    end
    function GetRect();
    begin
        return fParent.GetItemRect(self);
    end 
    property menu read fmenu;
    property Enabled read GetEnabled;
    property visible read getvisible;
    property caption read getcaption;
    private
    function GetEnabled();
    begin
        return fmenu.Enabled;
    end 
    function getcaption();
    begin
        return fmenu.Caption;
    end 
    function getvisible(); //可见
    begin
        return true;
    end 
    fmenu;
    fParent;
end 
type TcustomToolButton=class(tcomponent)
    {**
    @explan(说明) 工具栏项 %%
    **}
    function Create(AOwner);override;
    begin
        inherited;
        FCaption := "toolbtn"; //标题
        FImageId :=-1; //imageid
        FEnabled := true; //有效 可以点击
        FVisible := true; //可见 
    end
    function ExecuteCommand(cmd,d);override;
    begin        
        if cmd="doshortcut" then //shortcut 
        begin
            if fstyle=2 then return ;
            if csDesigning in ComponentState then return;
            if Enabled and Visible then
            begin
                if d=ShortCut then
                begin
                    DoOnClick(self,new tuieventbase(0,0,0,0));
                    return "havedoshortcut";
                end
            end
        end
    end
    function DoOnClick(o,e);virtual;
    begin
        if fStyle=2 then return ;
        if Parent then 
        begin
            if FPopupMenu is class({TcustomPopupmenu}TcustomMenu) then 
            begin
                Parent.PopupMenu := FPopupMenu;
                rec := GetRect();
                xy := Parent.clienttoscreen(rec[0],rec[3]);
                uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
                _wapi.TrackPopupMenu(FPopupMenu.Handle,uf,xy[0],xy[1],0,Parent.Handle,nil);
                return ;
            end 
        end 
        if action and action.Execute()then
        begin
        
        end else
            CallMessgeFunction(OnClick,o,e);
    end
    function GetRect();
    begin
        {**
        @explan(说明) 获得区域%%
        @return(array) 区域  %%
        **}
        if parent and parent.HandleAllocated()then return parent.GetItemRect(self);
    end
    function Recycling();override;
    begin
        if FToolbar then
        begin
            FToolbar.DeleteButton(self(true));
        end
        if FActionLink is class(TControlActionLink)then
        begin
            FActionLink.Recycling();
            FActionLink := nil;
        end
        FToolbar := nil;
        inherited;
        FPopupMenu := nil;
        FCaption := ""; //标题
        FOnClick := nil; //点击
        FImageId :=-1; //imageid
        FEnabled := true; //有效 可以点击
        FVisible := true; //可见 
    end
    property OnClick:eventhandler read FOnClick write FOnClick;
    property Caption:string read FCaption write SetCaption;
    property ImageId:integer read FImageId write SetImageId;
    property Enabled:bool read FEnabled write SetEnabled;
    property Visible:bool read FVisible write SetVisible;
    property ToolBar read FToolbar write SetParent;
    property Parent read FToolbar write SetParent;
    property willaddBar read FWillAddbar;
    property Action:taction read GetAction write SetAction;
    property ShortCut read getShortCut write SetShortCut;
    property PopupMenu:tpopupmenu read FPopupMenu write FPopupMenu;
    property stylesep:bool read getStylesep write setstylesep;
    property style read fstyle write setstyle;
    {**
    @param(OnClick)(function[o:TToolButton;e:tuieventbase]) 点击消息 %%
    @param(Caption)(string) 标题 %%
    @param(ImageId)(integer) 图标id %%
    @param(Enabled)(bool) 是否有效 %%
    @param(Visible)(bool) 是否可见 %%
    **}
    private
    FShortCut;
    fStyle;
    function setstyle(v);
    begin
        if not(v in array(0,1,2)) then return ;
        if fStyle<>v then 
        begin
            fStyle := v;
            if FToolbar then
            begin
                FToolbar.ExecuteCommand("btnchanged",0);
            end 
        end     
    end 
    function getStylesep();
    begin
        return fstyle=2;
    end 
    function setstylesep(v);
    begin
        nv := v?true:false;
        setstyle(v?2:0);
    end 
    function getShortCut();
    begin
        return formatshortcut(FShortCut);
    end
    function SetShortCut(v);
    begin
        if v and ifstring(v)then
        begin
            nst := parsershortcutstr(v);
        end else
        nst := nil;
        if nst <> FShortCut then
        begin
            FShortCut := nst;
        end
    end
    function SetParent(tb);
    begin
        if FToolbar=tb then return; //相同
        if FWillAddbar=tb and tb then
        begin
            FToolbar := tb;
            FWillAddbar := nil;
            return;
        end
        if FToolbar <> tb then
        begin
            if FToolbar is class(TcustomToolBar)then //删除
            begin
                FWillAddbar :=-1986;
                FToolbar.DeleteButton(self(true));
                FWillAddbar := nil;
                FToolbar := nil;
            end
        end
        if tb is class(TcustomToolBar)then
        begin
            FWillAddbar := tb;
            tb.AddButton(self(true));
            SetParent(tb);
        end
        FWillAddbar := nil;
    end
    function SetCaption(s);
    begin
        if ifstring(s)and s <> FCaption then
        begin
            FCaption := s;
            if fStyle=1 and FToolbar then 
            begin
                FToolbar.ExecuteCommand("btnchanged",0);
            end 
        end
    end
    function SetEnabled(v);
    begin
        nv := v?true:false;
        if nv <> FEnabled then
        begin
            FEnabled := nv;
            if FToolbar then 
            begin
                FToolbar.ExecuteCommand("btnchanged",0);
            end 
        end
    end
    function SetVisible(v);
    begin
        nv := v?true:false;
        if nv <> FVisible then
        begin
            FVisible := nv;
            if FToolbar then 
            begin
                FToolbar.ExecuteCommand("btnchanged",0);
            end 
        end
    end
    protected //action 
    function SetAction(Value);virtual;
    begin
        if ifnil(Value)then
        begin
            if FActionLink then
            begin
                FActionLink.SetAction(nil);
            end
            excludestate(FControlStyle,csActionClient);
        end else
        if Value is class(TBasicAction)then
        begin
            includestate(FControlStyle,csActionClient);
            if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
            FActionLink.Action := Value;
            FActionLink.Onchange := thisfunction(DoActionChange);
            ActionChange(Value,csLoading in Value.ComponentState);
            Value.FreeNotification(Self);
        end
    end
    procedure DoActionChange(Sender:TObject);
    begin
        if Sender=Action then ActionChange(Sender,False);
    end
    function GetAction();virtual;
    begin
        if FActionLink then
        begin
            return FActionLink.Action;
        end
    end
    function GetActionLinkClass();virtual;
    begin
        {**
        @explan(说明) 返回actionlinkclass %%
        @return(TMenuActionLink class)
        **}
        return class(TtoolbuttonActionLink);
    end
    procedure ActionChange(Sender:TObject;CheckDefaults:Boolean);virtual;
    begin
        if Sender is class(TCustomAction)then
        begin
            NewAction := Sender;
            if(not CheckDefaults)or(Caption='')or(Caption=Name)then Caption := NewAction.Caption;
            if(not CheckDefaults)then ShortCut := NewAction.ShortCut;
            if(not CheckDefaults)or Enabled then Enabled := NewAction.Enabled;
            //if not CheckDefaults or FChecked then Checked := NewAction.Checked;
        end;
    end
    protected
    function SetImageId(id);virtual;
    begin
        if ifnumber(id)and id <> FImageId then
        begin
            FImageId := id; //刷新一下
            if FToolbar then 
            begin
                FToolbar.ExecuteCommand("btnchanged",0);
            end 
        end
    end
    private
    FPopupMenu;//弹出菜单
    FCaption; //标题
    FOnClick; //点击
    FCommandId; //command id 可以不要
    FImageId; //imageid
    FEnabled; //有效 可以点击
    FVisible; //可见 
    FToolbar; //工具栏
    FWillAddbar;
    FActionLink;
end
type TcustomToolBar=class(TCustomControl)
    {**
    @explan(说明) 工具栏控件 %%   
    **}
    function Create(AOwner);override;
    begin
        inherited;        
    end
    function AfterConstruction();override;
    begin
        inherited;
        height := 28;
        Width := 300;
        Align := alTop;
        FButtons := new tnumindexarray();
        caption := "ToolBar";
        FBtnRects := array();
        FTipWnd := new TTipWnd(self);
        FTipWnd.Parent := self;
        FTimer := new TCustomTimer(self);
        FTimer.Interval := 200;
        FTimer.Ontimer := thisfunction(DoTimerShowTip);
    end 
    function FontChanged(o);override;
    begin
        inherited;
        if fmainmenu then doControlALign();        
    end 
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        FShowLoked := true;
        if e.Button()=mbLeft then
        begin
            FMouseDownIdx := PosInBtn(e.pos);
            EndShowWnd();
            if FMouseDownIdx >= 0 then
            begin
                if not(getbtnitem(FMouseDownIdx).Enabled)then
                begin
                    FMouseDownIdx :=-1;
                    return;
                end
                InvalidateRect(nil,false);
            end
        end
    end
    function ContextMenu(o,e);override;
    begin
        if csDesigning in ComponentState then 
        begin 
            return inherited;
        end 
        e.skip := true;
    end
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        FShowLoked := false;
        if e.Button()=mbLeft then
        begin
            idx := PosInBtn(e.pos);
            if idx >= 0 then
            begin
                if FMouseDownIdx=idx then
                begin
                    bi := getbtnitem(idx);
                    bi.DoOnClick(bi,e);
                end;
            end
        end
        if FMouseDownIdx >= 0 then
        begin
            FMouseDownIdx :=-1;
            InvalidateRect(nil,false);
        end
    end
    function MouseMove(o,e);override;
    begin
        if csDesigning in ComponentState then return;
        if FTimer.Enabled then return;
        idx := PosInBtn(e.pos);
        if idx<0 then return;
        FShowtimeIndexA := idx;
        if fmainmenu then return ;
        FTimer.Start();
    end
    function DoCNALIGN(o,e);override;
    begin
        case Align of
            alTop,alBottom:
            begin
                bs := UnAlignBounds;
                nh := CalcHeightFixWidth(e.width);
                dh := nh-(bs[3]-bs[1]);
                bs[3]+= dh;
                FUnAlignBounds := bs;
            end
            alLeft,alRight:
            begin
                bs := UnAlignBounds;
                nh := CalcWidthFixHeight(e.height);
                dh := nh-(bs[2]-bs[0]);
                bs[2]+= dh;
                FUnAlignBounds := bs;
            end
        end
        inherited;
    end
    function DoTimerShowTip(); //定时器
    begin
        FCurrentPos := array(0,0);
        _wapi.getcursorPos(FCurrentPos);
        FCurrentPos := ScreenToClient(FCurrentPos[0],FCurrentPos[1]);
        idx := PosInBtn(FCurrentPos);
        if idx<0 then
        begin
            EndShowWnd();
            FShowLoked := false;
            FMouseDownIdx :=-1;
            InvalidateRect(nil,false);
            return;
        end
        if FShowLoked then return;
        if FShowTimeIndexA=idx then //依然存在
        begin
            if not FTipWnd.Visible then
            begin
                bt := FButtons[idx];
                st := bt.ShortCut;
                if bt.PopupMenu is class({TcustomPopupmenu}TcustomMenu) then s1 := bt.PopupMenu.Caption;
                else s1 := bt.Caption;
                FTipWnd.Tip := s1+(st?("  ("+st+")"):"");
                FTipWnd.ShowTIp();
            end
        end else
        begin
            EndShowWnd();
        end
    end
    function AddButton(btn);
    begin
        {**
        @explan(说明) 添加工具栏项%%
        **}
        InsertButton(btn);
    end
    function getbtnbyindex(idx);
    begin
        return FButtons[idx];
    end 
    function SetBtnIndex(btn,idx);
    begin
        {**
        @explan(说明) 修改按钮的位置 %%;
        @param(btn)(TToolButton) 工具栏项 %%
        @param(idx)(TToolButton | integer) 位置 %%
        **}
        if not(idx >= 0)then return -1;
        cidx := IndexOfBtn(btn);
        if cidx<0 then return -1;
        if cidx=idx then return idx;
        btnlength := FButtons.Length();
        if idx>cidx then
        begin
            for i := cidx to min(btnlength-1,idx)-1 do
            begin
                FButtons.swap(i,i+1);
            end
        end else
        begin
            for i := idx to cidx-1 do
            begin
                FButtons.swap(i,i+1);
            end
        end
        if Btn.Visible then InvalidateRect(nil,false);
        return cidx;
    end
    function InsertButton(btn,idx);
    begin
        {**
        @explan(说明) 在指定位置插入按钮 %%
        @param(btn)(TToolButton) 工具栏项 %%
        @param(idx)(TToolButton | integer) 位置 %%
        **}
        if not(btn is class(TcustomToolButton))then return;
        cidx := IndexOfBtn(btn);
        //位置计算
        if cidx >= 0 then return;
        if btn.willaddBar <> self then
        begin
            return btn.parent := self(true);
        end
        FButtons.push(btn);
        nidx := nil;
        if idx >= 0 then nidx := idx;
        else if ifobj(idx)then nidx := IndexOfBtn(idx);
        if nidx >= 0 then SetBtnIndex(btn,nidx);
        if btn.Visible then
        begin
            IncPaintLock();
            InvalidateRect(nil,false);
            FWillModifyToolbar := true;
            DecPaintLock();
        end
    end
    function DeleteButton(btn); //删除按钮
    begin
        {**
        @explan(说明) 在删除按钮 %%
        @explan(说明) 删除button %%
        @param(btn)(TToolButton) 工具栏项%%
        **}
        idx := IndexOfBtn(btn);
        if idx=-1 then return -1;
        if btn.willaddBar <>-1986 then
        begin
            return btn.Parent := nil;
        end
        FButtons.splice(idx,1);
        if btn.Visible then
        begin
            IncPaintLock();
            InvalidateRect(nil,false);
            FWillModifyToolbar := true;
            DecPaintLock();
        end
    end
    function GetItemRect(btn); //获得按钮区域
    begin
        {**
        @explan(说明) 获得按钮的区域 %%
        @param(btn)(TToolButton) 工具栏项%%
        @return(array) 区域 %%
        **}
        for i,v in FButtons.data do 
        begin
            if v=btn then return FBtnRects[i];
        end 
        for i,v in fmenubtns.data do 
        begin
            if v=btn then return fmenubtnrects[i];
        end 
        return array(0,0,0,0);
    end
    function IncPaintLock(); //锁定刷新
    begin
        {**
        @explan(说明) 锁定绘制,和 DecPaintLock() 成对使用 %%
        **}
        BeginUpdate();
    end
    function DecPaintLock(); //释放刷新
    begin
        {**
        @explan(说明) 取消绘制锁定,和 IncPaintLock() 成对使用 %%
        **}
        EndUpdate();
    end
    
    function Paint();override;
    begin
        c := canvas;
        c.font := font;
        for i := 0 to getbtncount()-1 do
        begin
            bi := getbtnitem(i);
            if not(bi.Visible)then continue;
            ci := getbtnrect(i);
            if not ifarray(ci)then return;
            if FMouseDownIdx=i then
            begin
                if fmainmenu then 
                begin
                    c.brush.Color := 0xffffbb;
                    c.FillRect(ci);
                end 
                else 
                    c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK);
            end else
            begin
                if fmainmenu then 
                begin
                    c.brush.Color := Color;////;
                    c.FillRect(ci);
                end 
                else
                begin 
                    if bi.enabled then 
                    begin
                        c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);    
                    end else 
                    begin 
                        c.brush.Color := 0x8c8c8c;////0xc0c0cc;
                        c.FillRect(ci);
                    end
                end                      
            end 
            if fmainmenu then 
            begin 
                c.drawtext(bi.Caption,ci,DT_VCENTER.|DT_CENTER .|DT_SINGLELINE);
                continue;
            end 
            igslist := ImageList;
            if igslist is class(TCustomImageList)then
            begin
                igid := bi.ImageId;
                if igid >= 0 and igid<igslist.ImageCount then
                begin
                    if bi.Enabled then igslist.draw(igid,c,ci[0]+2,ci[1]+2,nil);
                    else igslist.draw(igid,c,ci[0]+2,ci[1]+2,ILC_COLOR4);
                end
            end
        end
    end
    function DoEndUpDate();override; //锁定刷新释放
    begin
        if not(IsUpDating())then
        begin
            if FWillModifyToolbar then
            begin
                FWillModifyToolbar := false;
                DoControlAlign();
                if Parent then Parent.DoControlAlign();
            end
        end
        inherited;
    end
    function DoControlAlign();override;
    begin
        CalcButtonsRect();
    end
    function CalcHeightFixWidth(w);
    begin
        {**
        @explan(说明) 固定宽度计算工具栏高度 %%
        @param(w)(integer) 给定宽度  %%
        @return(intger) 计算的高度 %%
        **}
        bw := 0;
        //16 6 2 简化边框处理
        if WSSizebox or WsDlgModalFrame or Border then bw := 2;
        if fmainmenu then 
        begin
            return font.Height+bw+4;
        end 
        imglst := ImageList; //图标
        imgw := 28;
        imgh := 28;
        if imglst is class(TCustomImageList)then
        begin
            imgw := imglst.Width+4;
            imgh := imglst.height+4;
        end
        nh := w-bw;
        bct := 0;
        for i := 0 to FButtons.Length()-1 do //调整大小
        begin
            bi := FButtons[i];
            if not(bi.Visible)then
            begin
                continue;
            end
            bct++;
        end
        if bct=0 then return imgh+bw;
        rct := integer((nh+2)/(imgw+1));
        if rct<1 then rct := 1;
        //echo "总共:",bct,"每行:",rct,"===行数",(integer( bct/rct)+1),"\r\n";
        nt := bct/rct;
        return((frac(nt)>0)?(integer(nt)+1):(nt)) * (imgh+1)+bw;
        return(integer(bct/rct)+1) * (imgh+1)+bw;
    end
    function CalcWidthFixHeight(h);
    begin
        {**
        @explan(说明) 固定高度计算工具栏宽度 %%
        @param(w)(integer) 给定高度  %%
        @return(intger) 宽度 %%
        **}
        bw := 0;
        if WSSizebox or WsDlgModalFrame or Border then  bw := 2;
        if fmainmenu then 
        begin            
            return 40;
        end 
        imglst := ImageList; //图标
        imgw := 28;
        imgh := 28;
        if imglst is class(TCustomImageList)then
        begin
            imgw := imglst.Width+4;
            imgh := imglst.height+4;
        end
        nh := h-bw;
        bct := 0;
        for i := 0 to FButtons.Length()-1 do
        begin
            bi := FButtons[i];
            if not(bi.Visible)then
            begin
                continue;
            end
            bct++;
        end
        if bct=0 then return imgw+bw;
        rct := integer((nh+2)/(imgh+1));
        if rct<1 then rct := 1;
        nt := bct/rct;
        return((frac(nt)>0)?(integer(nt)+1):(nt)) * (imgw+1)+bw;
        return(integer(bct/rct)+1) * (imgw+1)+bw;
    end
    function IndexOfBtn(btn);
    begin
        {**
        @explan(说明) 获得按钮序号 %%
        @param(btn)(TToolButton) 按钮  %%
        @return(integer) >=0表示正确序号 %%
        **}
        for i := 0 to FButtons.length()-1 do 
        begin
            if btn = FButtons[i] then return i;
        end 
        return -1;
    end
    function Notification(a,op);override;
    begin
        if a=fmainmenu and op=opRecycling then 
        begin
            setmainmenu(nil);
        end     
        inherited;
    end 
    function Recycling();override;
    begin
        while FButtons.Length()>0 do
        begin
            DeleteButton(FButtons[0]);
        end
        inherited;
        FShowLoked := true;
        FBtnRects := nil;
        FButtons := nil;
        FTipWnd := nil;
        FShowtimeIndexA := nil;
        FTimer := nil;
        FCurrentPos := nil;
        FMouseDownIdx :=-1;
        fmainmenu := nil;
        fmenubtns := nil;
    end
    function ExecuteCommand(cmd,pm);override;
    begin
        case cmd  of 
            "btnchanged":
            begin
                if fmainmenu then return ;
                if not HandleAllocated() then return ;
                CalcButtonsRect();
                InvalidateRect(nil,false);
                return 0;
            end 
        end ;
        return inherited;
    end 
    property MainMenu:tmainmenu read fmainmenu write setmainmenu;
    protected
    procedure SetAlign(Value:TAlign);override;
    begin
        if Align=Value then exit;
        if Value in array(alClient)then
        begin
            return;
        end
        inherited;
    end
    function ImageChanged();override;
    begin
        if IsUpDating()then return;
        if fmainmenu then return ;
        if Parent then
        begin
            Parent.DoControlAlign();
            CalcButtonsRect();
            InvalidateRect(nil,false);
        end
    end

    private
    function mainmenuchanged();
    begin
        fmenubtns := new tnumindexarray();
        for i:= 0 to  fmainmenu.ItemCount-1 do 
        begin
            fmenubtns.push(new tcustommenubutton( fmainmenu.GetItemByIndex(i),self(true)));
        end    
        CalcButtonsRect();
    end 
    function setmainmenu(v); //设置主菜单
    begin
        if v<>fmainmenu then 
        begin
            if v is class(TcustomMainmenu) then 
            begin
                fmainmenu := v; 
                fmainmenu.onchanged := thisfunction(mainmenuchanged);
                mainmenuchanged();                
            end else 
            begin
                fmainmenu := nil; 
                fmenubtns := new tnumindexarray();
            end 
            doControlALign();
            InvalidateRect(nil,false);                
        end 
    end 
    function EndShowWnd();//提示框
    begin
        FShowTimeIndexA :=-1;
        FTimer.Stop();
        FTipWnd.Visible := false;
    end
    
    function CalcButtonsRect(); //计算按钮区域
    begin
        if(IsUpDating())then
        begin
            FWillModifyToolbar := true;
            return;
        end
        if fmainmenu then 
        begin
            rc := ClientRect;
            y := rc[1];
            x := rc[0]+1;
            fmenubtnrects := array();
            for i:= 0 to fmenubtns.length()-1 do
            begin
                mu := getbtnitem(i);
                if mu.Visible then 
                begin 
                    s := mu.Caption;
                    wh := GetTextWidthAndHeightWidthFont(s,self.font,0);// wh
                    nwh := x+wh[0]+15;
                    fmenubtnrects[i]:= array(x,y,nwh,rc[3]);
                    x:=nwh;
                    if x>rc[2] then break; //只有一行
                end else 
                begin
                    fmenubtnrects[i] := array(0,0,0,0);
                end 
            end 
            return ;
        end 
        imglst := ImageList; //图标
        imgw := 28;
        imgh := 28;
        if imglst is class(TCustomImageList)then
        begin
            imgw := imglst.Width+4;
            imgh := imglst.height+4;
        end
        rc := ClientRect;
        FBtnRects := array();
        x := y := 0;
        rct := 0;
        case Align of
            alLeft,alRight:
            begin
                for i := 0 to FButtons.Length()-1 do //调整大小
                begin
                    bi := FButtons[i];
                    if not(bi.Visible)then
                    begin
                        FBtnRects[i]:= array(0,0,0,0);
                        continue;
                    end
                    if y+imgh>rc[3]then
                    begin
                        if rct=0 then
                        begin
                            if bi.stylesep then 
                            begin 
                                FBtnRects[i]:= array(0,0,0,0);
                            end else 
                            begin
                                FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                            end 
                            y := 0;
                            x += imgw+1;
                        end else
                        begin
                            y := 0;
                            x += imgw+1;
                            if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
                            else 
                                FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                            y += imgh+1;
                            rct := 1;
                        end
                    end else
                    begin
                        if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
                        else 
                        FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                        y += imgh+1;
                        rct++;
                    end
                end
            end else
            begin
                for i := 0 to FButtons.Length()-1 do //调整大小
                begin
                    bi := FButtons[i];
                    if not(bi.Visible)then
                    begin
                        FBtnRects[i]:= array(0,0,0,0);
                        continue;
                    end
                    if x+imgw>rc[2]then
                    begin
                        if rct=0 then
                        begin
                            if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
                            else 
                                FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                            x := 0;
                            y += imgh+1;
                        end else
                        begin
                            x := 0;
                            y += imgh+1;
                            if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
                            else 
                                FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                            x += imgw+1;
                            rct := 1;
                        end
                    end else
                    begin
                        if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
                        else 
                            FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
                        x += imgw+1;
                        rct++;
                    end
                end
            end
        end;
    end
    function PosInBtn(p);
    begin
        for i := 0 to getbtncount()-1 do
        begin
            ri := getbtnrect(i);
            if ri and pointinrect(p,ri)then
            begin
                return i;
            end
        end
        return -1;
    end
    function getbtnitem(idx);
    begin
        if fmainmenu then return fmenubtns[idx];
        return FButtons[idx];
    end 
    function getbtncount();
    begin
        if fmainmenu then return fmenubtns.length();
        return FButtons.length();
    end 
    function getbtnrect(idx);
    begin
        if fmainmenu then return fmenubtnrects[idx];  
        return FBtnRects[idx];  
    end 
    FShowLoked;
    FBtnRects;
    FButtons;
    
    fmenubtns;
    fmenubtnrects;
    
    FTipWnd;
    FShowtimeIndexA;
    FTimer;
    FCurrentPos;
    FMouseDownIdx;
    FWillModifyToolbar;
    fmainmenu;
end
type TcustomStatusBar=class(TCustomControl)
    {**
    @explan(说明) 状态栏 %%
    **}
    private
    Fitems;
    FCwid;
    FCHei;
    function itemidok(id);
    begin
        ct := length(Fitems);
        return id >= 0 and id<ct;
    end
    function setitems(its);
    begin
        {**
        @explan(说明) 设置多个项目 %%
        **}
        Fitems := array();
        for i,v in its do
        begin
            if ifarray(v)then additem(v["text"],v["width"]);
        end
    end
    function DrawStatItem(cvs,v,rec);
    begin
        cvs.Draw("FrameControl",array(rec[0:1],rec[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); //DFCS_CHECKED DFCS_FLAT
        hstr := v["text"];
        if hstr and ifstring(hstr)then
        begin
            cvs.Font := font;
            cvs.drawtext(hstr,rec,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
        end
    end
    protected
    procedure SetAlign(Value:TAlign);override;
    begin
        if Align=Value then exit;
        if Value in array(alBottom)then
        begin
            inherited;
        end
    end
    public
    function create(AOwner);override;
    begin
        inherited;
        height := 25;
        Align := alBottom;
        Fitems := array();
    end
    function DoWMsIZE();override;
    begin
        c := clientRect;
        FCwid := c[2];
        FCHei := c[3];
    end
    function Paint();override;
    begin
        p := 0;
        cvs := canvas;
        if FItems then
        begin
            for i,v in FItems do
            begin
                wd := v["width"];
                if wd>0 and wd<1.0001 then
                begin
                    wd *= FCwid;
                end
                DrawStatItem(cvs,v,array(p,0,p+wd,FCHei));
                p += wd;
                if p>FCwid then return;
            end
        end
        if p<FCwid then
        begin
            DrawStatItem(cvs,array(),array(p,0,FCwid,FCHei));
        end
    end
    function additem(str,wd);
    begin
        {**
        @explan(说明)添加项目 %%
        @param(str)(string) 文本 %%
        @param(wd)(number) 宽度 ,大于1 表示绝对宽阔 ,小于1 表示相对宽度 %%
        **}
        if not ifstring(str)then return -1;
        if not(wd>0)then wd := 100;
        Fitems[Length(Fitems)]:= array("text":str,"width":wd);
        if HandleAllocated()then
        begin
            InvalidateRect(nil,false);
        end
    end
    function deleteitem(id);
    begin
        {**
        @explan(说明) 删除项目 %%
        @param(id)(integer) 序号 %%
        **}
        if not(itemidok(id))then return -1;
        deleteindex(Fitems,id,true);
        if HandleAllocated()then
        begin
            InValidateRect(nil,false);
        end
    end
    function setitemtext(str,id);
    begin
        {**
        @explan(说明) 修改字段 %%
        @param(str)(string) 文本%%
        @param(id)(integer) 序号 %%
        **}
        if not ifstring(str)then return-1;
        if not(itemidok(id))then return -1;
        Fitems[id,"text"]:= str;
        if HandleAllocated()then
        begin
            InvalidateRect(nil,false);
        end
    end
    property Items:statusitems read Fitems Write SetItems;
    {**
    @param(Items)(array)设置项 ,二维数组包括 text ,width 两个字段 array(("text":"abc","width":200),("text":"part2","width":0.4))%%
    **}
end
type TCustomSpinEdit = class(TCustomControl)
    {**
    @explan(说明)spinedit控件
    **}
    private
    FEdit;
    FUDwidth;
    FUPrect;
    FDownrect;
    FCI;
    CI_UP;
    CI_DOWN;
    CIS_NONE;
    CIS_MOUSEDOWN;
    CIS_MOUSEUP;
    CIS_MOUSEON;
    FIncrement: Double;
    FDecimals: Integer;
    FMaxValue: Double;
    FMinValue: Double;    
    FValue: Double;  
    FOnIncrease;
    FOnDecrease;
    FLeveTimer;
    function DrawItem(id,f);
    begin
        ys := 0;
        case id of
            CI_UP:
            begin
                rec := FUPrect;
                ys := DFCS_SCROLLup;
            end
            CI_DOWN:
            begin
                rec := FDownrect;
                ys := DFCS_SCROLLDOWN;
            end else
            return;
        end
        case f of
            CIS_MOUSEDOWN:
            begin
                //_wapi.DrawFrameControl(Canvas.Handle,rec,DFC_BUTTON,DFCS_BUTTONPUSH);
                Canvas.Draw("framecontrol",array(rec[0:1],rec[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH)
            end
            CIS_NONE:
            begin
                Canvas.Draw("framecontrol",array(rec[0:1],rec[2:3]),DFC_SCROLL,ys);
            end
            CIS_MOUSEON:
            begin
                //canvas.pen.color := rgb(100,200,100);
                //canvas.draw("Rectangle",array(rec[0:1],rec[2:3]));
            end
        end;
    end
    FChar;
    protected
    function UpdateControl();virtual;
    begin
        FEdit.Text := inttostr(FValue);
    end
    function GetValue();virtual;
    begin
        r := FEdit.text;
        r := StrToIntDef(r,FValue);
        if r <> FValue then
        begin
            FValue := r;
        end
        return FValue;
    end
    procedure SetValue(const AValue:Double);virtual;
    begin
        if AValue <> FValue then
        begin
            if AValue >= FMinValue and AValue <= FMaxValue then
            begin
                FValue := AValue;
                UpdateControl();
            end
        end
    end
    procedure SetMaxValue(const AValue:Double);virtual;
    begin
        if AValue <> FMaxValue then
        begin
            FMaxValue := AValue;
        end
    end
    procedure SetMinValue(const AValue:Double);virtual;
    begin
        if AValue <> FMinValue then
        begin
            FMinValue := AValue;
        end
    end
    procedure SetIncrement(const AIncrement:Double);virtual;
    begin
        nv := integer(AIncrement);
        if FIncrement <> nv and nv>0 then
        begin
            FIncrement := nv;
        end
    end
    function doIncrease(o,e);virtual;
    begin
        nv := GetValue()+FIncrement;
        if nv <= FMaxValue and nv >= FMinValue then
        begin
            CallMessgeFunction(FOnIncrease,o,e);
            if not e.skip then
            begin
                FValue := nv;
                UpdateControl();
            end
        end else
        begin
            if nv>FMaxValue then SetValue(FMaxValue);
            else if nv<FMinValue then SetValue(FMinValue);
        end
    end
    function doDcrease(o,e);virtual;
    begin
        nv := GetValue()-FIncrement;
        if nv <= FMaxValue and nv >= FMinValue then
        begin
            CallMessgeFunction(FOnDecrease,o,e);
            if not e.skip then
            begin
                FValue := nv;
                UpdateControl();
            end
        end else
        begin
            if nv>FMaxValue then SetValue(FMaxValue);
            else if nv<FMinValue then SetValue(FMinValue);
        end
    end
    public
    function dosetfocus(o,e);override;
    begin
        FEdit.setFocus();  
    end 
    function dokillfocus(o,e);override;
    begin
        FEdit.killFocus();        
    end 
    function editkeypress(o,e);virtual;
    begin
        c := e.wparam;
        if not(FChar.IsNumber(c)or(c=VK_BACK))then
        begin
            e.skip := true;
        end
    end
    function Create(AOwner);override;
    begin
        inherited;
        FChar := new TCharDiscrimi();
        //FLeveTimer := new TCustomTimer(self);
        //FChar.sinit();
        FMaxValue := 100;
        FMinValue := 0;
        //FValue := 0;
        FIncrement := 1;
        FDecimals := 2;
        Border := false;
        height := 25;
        Width := 60;
        FUDwidth := 20;
        FEdit := new teditable(self);
        FEdit.Visible := true;
        FEdit.border := true;
        FEdit.OnKeyPress := thisfunction(editkeypress);
        FEdit.host := self(true);
        FUPrect := array();
        FDownrect := array();
        CI_UP := 1;
        CI_DOWN := 2;
        CIS_NONE := 1;
        CIS_MOUSEDOWN := 2;
        CIS_MOUSEUP := 3;
        CIS_MOUSEON := 4;
        Value := 0;
    end
    function Recycling();override;
    begin
        FEdit.Recycling();
        fedit := nil;
        inherited;
    end
    function DoControlAlign(rect);override;
    begin
        rect := ClientRect;
        FEdit.ClientRect := array(rect[0],rect[1],rect[2]-FUDwidth,rect[3]);
        cl := rect; //ClientRect();
        cl[0]:= cl[2]-FUDwidth;
        cl2 := cl;
        h :=(cl[3]-cl[1])/2-1;
        cl[3]:= h;
        cl2[1]:= h+2;
        FUPrect := cl;
        FDownrect := CL2;
    end
    function WMKEYDOWN(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        fedit.WMKEYDOWN(o,e);
        if e.CharCode=VK_UP then 
        begin
            doIncrease(o,e);
        end else 
        if e.CharCode = VK_DOWN then 
        begin
            doDcrease(o,e);
        end 
    end 
    function WMCHAR(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        FEdit.WMCHAR(o,e);
    end 
    function MouseDown(o,e);override;
    begin  
        if csDesigning in ComponentState then return ; 
        p := e.pos;
        if pointinrect(p,FEdit.ClientRect)then 
        begin
            return FEdit.MouseDown(o,e);
        end             
    end
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        FEdit.MouseUp(o,e);
        if FCI=CI_DOWN then
        begin
            doDcrease(o,e);
            return ;
        end else
        if FCI=CI_UP then
        begin
            doIncrease(o,e);
            return ;
        end 
    end 
    function MouseMove(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        p := e.pos;
        if pointinrect(p,FUPrect)then
        begin
            FCI := CI_UP;
        end else
        if pointinrect(p,FDownrect)then
        begin
            FCI := CI_DOWN;
        end else
        begin
            FCI := 0;
            FEdit.MouseMove(o,e);
        end
    end
    function paint();override;
    begin
        FEdit.paint();
        DrawItem(CI_UP,CIS_NONE);
        DrawItem(CI_DOWN,CIS_NONE);
    end
    property OnIncrease:eventhandler read FOnIncrease write FOnIncrease;
    property OnDecrease:eventhandler read FOnDecrease write FOnDecrease;
    property Increment:integer read FIncrement write SetIncrement;
    property MinValue:integer read FMinValue write SetMinValue;
    property MaxValue:integer read FMaxValue write SetMaxValue;
    property Value:integer read GetValue write SetValue;
    {**
    @param(Increment)(integer) 增长间隔 %%
    @param(MinValue)(integer) 下界 %%
    @param(MaxValue)(integer) 上界 %%
    @param(Value)(integer) 值 %%
    @param(OnIncrease)(function[TCustomSpinEdit,tuieventbase]) 增加时的回调 %%
    @param(OnDecrease)(function[TCustomSpinEdit,tuieventbase]) 减少时的回调 %%
    **}
end
type tcustomgroupbox=class(TCustomControl)
    function create(owner);override;
    begin
        inherited;
        Left := 10;
        Top := 10;
        Width := 185;
        Height := 105;
        caption := "group";
        Color := rgb(240,240,240);
        FtextPosition := 0;
    end
    function Paint();override;
    begin
        c := caption;
        if Parent and ParentFont then
        begin
            ft := Parent.Font;
        end else
            ft := Font;
        wf := ft.width;
        hf := ft.height+2;
        cvs := Canvas;
        cvs.pen.color := rgb(170,170,170);
        cvs.pen.width := 1;
        cwd := 0;
        if c then
        begin
            cwd := wf * length(c)+1;
        end
        rc := ClientRect;
        hf2 := integer(hf/2);
        ///////////////////////////////////////
        cvs.moveto(array(3,hf2));
        cvs.LineTo(array(3,rc[3]-3));
        cvs.LineTo(array(rc[2]-3,rc[3]-3));
        cvs.LineTo(array(rc[2]-3,hf2));
        cvs.LineTo(array(3,hf2));
        ///////////////////////////////////////
        /////////////////////////////////////////
        txpos := 10;
        if c then
        begin
            if cwd<(rc[2]-rc[0]-20)then
            begin
                case FtextPosition of
                    2:
                    begin
                        txpos := 10+integer((rc[2]-rc[0]-20-cwd)/2);
                    end
                    3:
                    begin
                        txpos := rc[2]-rc[0]-10-cwd;
                    end
                end;
            end
            cvs.pen.color := Color;
            cvs.moveto(array(txpos-1,hf2));
            cvs.LineTo(array(txpos+cwd+1,hf2));
            cvs.textout(c,array(txpos,0));
        end
        drawdesigninggrid();
        /////////////////////////////////		    
    end
    property textPos:AlignStyle9 read FtextPosition write setTextPosition;
    private
    function setTextPosition(n);
    begin
        if(n in array(0,1,2,3))and n <> FtextPosition then
        begin
            FtextPosition := n;
            InvalidateRect(nil,false);
        end
    end
    FtextPosition;
end
type tcustomprogressbar=class(TCustomControl)
    {**
        @explan(说明) 进度栏
        进度栏是显示任务进行完成度的控件。进度栏的上下限是进度条位置可移动的
        范围，可以通过range属性获取、修改，其默认值是array(0,100)。进度条的位置可以通过
        position属性获取、修改。进度栏的步增量是其每次调用increaseByStep函数进度条
        位置移动的量，可以通过step属性获取、修改，其默认值是10.
        进度条默认是分段离散的，可通过修改smooth成员设置其为平滑连续的。默认是
        水平从左到右移动，可通过修改vertical成员来设置其为垂直从底部到顶部移动。
    **}    
    public
    function create(AOwner);override;
    begin
    inherited;
        Caption:="prograssbar";
        FLeft := 10;
        FTop := 10;
        Width := 150;
        Height :=20;
        Fsmooth:=0;
        Fvertical:=0;
        Frange:=array(0,100);
        Fposition:=0;
        Fstep:=10;
        FbarColor:=0xD77800;
        color:=0xf0f0f0;
    end
    function paint();override;
    begin
        inherited;
        dc := Canvas;
        r := ClientRect;
        h := r[3]-r[1];
        w := r[2]-r[0];
        br := r;
        rt  := (Fposition/(Frange[1]-Frange[0]));
        if Fvertical then 
        begin 
            d := rt *h; 
            br[1] +=(h-d);  
        end else 
        begin 
            d := floor(rt*w); 
            br[2] :=  br[0]+d;   
        end 
        dc.brush.color := FbarColor;
        dc.FillRect(br);   
        if not Fsmooth then 
        begin
            pc := dc.pen.Color;
            pw := dc.pen.Width;
            dc.pen.Color := color;
            dc.pen.Width := 2;
            sp := 18;                       
            if Fvertical then 
            begin
                p := br[3]-sp;
                while p>br[1] do 
                begin
                    dc.moveto(array(r[0],p));
                    dc.LineTo(array(r[2],p));
                    p-=sp;
                    
                end 
            end else 
            begin
                p := sp ; 
                while p<br[2] do 
                begin
                    dc.moveto(array(p,r[1]));
                    dc.LineTo(array(p,r[3]));
                    p+=sp;
                end         
            end  
            dc.pen.Color := pc;
            dc.pen.Width := pw;       
        end   
    end 
    function increaseByStep();
    begin
        {**
            @explan(说明)按照步增量移动进度条当前的位置，当其超过限度则设置位置至下限以便于从头重新开始%%
            @return(integer)先前的位置，出错返回-1%%
        **}
        r:=Fposition;
        Fposition+= Fstep;
        if Fposition>Frange[1] then
            Fposition := Frange[0];
        else if Fposition<Frange[0] then
            Fposition := FRange[1];
        InvalidateRect(nil,false);
        return r;
    end
    function increaseBySpecifiedIncrement(n);
    begin
        {**
            @explan(说明)进度条移动指定长度，当其超过限度则设置位置至该限度%%
            @param(n)(integer)增长的数量%%
            @return(integer)先前的位置，出错则返回-1%%
        **}	
        r := Fposition;
        if n<>0 then 
        begin 	
            setPosition(n*Fstep);    
        end 
        return r;
    end
    property smooth:bool read Fsmooth write setSmooth;
    property vertical:bool read Fvertical write setVertical;
    {**
        @param(smooth)(bool)进度条平滑移动%%
        @param(vertical)(bool)进度条垂直移动%%
    **}
    property range:pairint read Frange write setRangeA;
    property position:integer read Fposition write setPosition;
    property stepincrement:integer read Fstep write setStep;
    property barColor:color read FbarColor write setIndicatorBarColor;
    {**
        @param(range)(array of integer)进度栏的上下限%%
        @param(position)(integer)进度条的位置%%
        @param(stepincrement)(integer)进度栏的步增量%%
    **}    

    private //属性
    Fsmooth;
    Fvertical;
    Frange;
    Fposition;
    Fstep;
    FbarColor;
    private //属性处理函数
    function setSmooth(n);
    begin
        Fsmooth := n;
    end
    function setVertical(n);
    begin
        nv := n?true:false;
        if nv = Fvertical then return ;
        Fvertical := nv;  
        InvalidateRect(nil,false);  
    end
    function isValidPosition(n);
    begin
        return n>=Frange[0] and n<=Frange[1];
    end
    function isValidColorValue(n);
    begin
        if ifint(n) then
            return not (n.&0xFF000000);
        else 
        if ifint64(n) then
            return not (n.&0xFFFFFFFFFF000000);
        else return 0;
    end
    function setRange(l,h);
    begin
        {**
            @explan(说明)设置进度栏的上下限，要求上限高于下限且皆非负%%
            @param(l)(integer)下限%%
            @param(h)(integer)上限%%
            @return(integer)1:成功;0:失败;-1:出错%%
        **}
        if Frange=array(l,h) then return ;
        if ifnumber(l) and ifnumber(h) and l>=0 and h>=l+1 then 
        begin
            l:=integer(l);
            h:=integer(h);
            Frange:=array(l,h);
            Fposition:=Fposition<l?l:(Fposition>h?h:Fposition);
            return 1;
        end
    
    end
    function setRangeA(arr);
    begin
        return setRange(arr[0],arr[1]);
    end
    function setPosition(n);
    begin
        {**
            @explan(说明)设置进度条位置，当其超过限度则设置位置至该限度%%
            @param(n)(integer)要设置的位置%%
            @return(integer)先前位置，出错则返回-1%%
        **}
        r := Fposition;
        if ifnumber(n) and isValidPosition(n)  then 
        begin
            Fposition:=n;
            InvalidateRect(nil,false);
        end        
        return r;
    end
    function setStep(n);
    begin
        {**
        @explan(说明)设置进度栏步增量%%
        @param(n)(integer)要设置的值%%
        @return(integer)1:成功;0:失败;-1:出错%%
        **}
        if Fstep=n then return ;
        d := Frange[1]-Frange[0];
        if ifnumber(n)   and n<=d then 
        begin
            Fstep:=integer(n);
            InvalidateRect(nil,false);
            return  1;
        end
    end
    function setIndicatorBarColor(clr);
    begin
        {**
            @explan(说明)设置进度条颜色%%
            @param(clr)(integer)要设置的颜色的rgb值%%
            @return(integer)1:成功;0:失败;-1:出错%%
        **}
        if ifnumber(clr) and  FbarColor<>clr and isValidColorValue(clr)  then 
        begin
            FbarColor:=integer(clr);
            InvalidateRect(nil,false);
            return 1;
        end
    end
end
type tcustomipaddr = class(TCustomControl)
	{**
		@explan(说明) ip控件 %%
	**}
    private
    type tipeditor = class(teditable)
        function create();
        begin
            inherited;
            border := false;
            FRange := array(0,1);
            UnLocked := true;
        end         
        function doonmaxtext();override;
        begin
            if FNext and Fnext.Visible then 
            begin
                KillFocus();
                ExecuteCommand("ecclcsel");
                FNext.SetFocus();
                FNext.ExecuteCommand("ecsel",array(1,10));
            end 
        end 
        function doOnChange();override;
        begin
            if host and UnLocked then 
            begin
                host.DoIpChanged();
            end 
        end 
        function GoToPrev();
        begin
            if FPrev then 
            begin
                KillFocus();
                ExecuteCommand("ecclcsel");  
                FPrev.SetFocus();
                FPrev.ExecuteCommand("ecsel",array(10,1));    
            end 
        end 
        function WMCHAR(o,e);override;
        begin
            case e.char of 
                "0" to "9" : 
                begin
                    inherited;
                end 
                " ","\t",".":
                begin
                    doonmaxtext();
                end 
                chr(VK_BACK):
                begin
                    inherited;
                    idx := ExecuteCommand("eccaretpos");
                    if idx=1 then return GoToPrev();  
                end         
            end 
        end 
        function WMKEYDOWN(o,e);override;
        begin
            case e.CharCode of
                VK_LEFT:
                begin
                    idx := ExecuteCommand("eccaretpos");
                    if idx=1 then return GoToPrev();  
                end 
                VK_RIGHT:
                begin
                    idx := ExecuteCommand("eccaretpos");
                    if idx>length(self.Text) then 
                    begin
                        return doonmaxtext();
                    end 
                end   
            end ;
            inherited;
        end 
        function GetNumValue();
        begin
            t := Text;
            r := StrToIntDef(t,FRange[0]);
            return r;
        end 
        function GetTureText();
        begin
            return Inttostr(GetNumValue());
        end 
        function SetNumValue(v);
        begin
            if v<=FRange[0] then return text := inttostr(FRange[0]);
            if v>=FRange[1] then return text := inttostr(FRange[1]);
            if v<FRange[1] and v>FRange[0] then text := inttostr(v);
        end 
        function SetRange(a,b);
        begin
            if a>=0 and b>a then 
            begin 
                if a <> FRange[0] or b<>FRange[1] then 
                begin 
                    FRange := array(a,b);
                    L := 1;
                    while 10^L<b do L++;
                        limitlength := L;
                end 
            end 
        end 
        FRange;
        FPrev;
        FNext;
        static UnLocked;
        {protected
        function filterstring(c);override;
        begin
            s := text;
            if s="0" and c="0" then return "";
            s+=c;
            if s then 
            begin            
                r := StrToIntDef(s,0);
                if  r<=FRange[1] then return c;
            end 
            return "";
        end }
    end 
    public
    function Create(AOwner);override;
    begin
        inherited;        
        //for i,v in FEditors do v.FIPValueChanged := thisfunction(DoIpChanged);	
    end 
    function AfterConstruction();override;
    begin
        inherited;
        minheight:=15;
        FFontwidth := 7;
        //FHasPort := 1;
        width := 180;
        height := 25;
        border := true;
        FIpe1 := new Tipeditor(self);
        FIpe2 := new Tipeditor(self);
        FIpe3 := new Tipeditor(self);
        FIpe4 := new Tipeditor(self);
        FPort := new Tipeditor(self);
        FEditors := array(FIpe1,FIpe2,FIpe3,FIpe4,FPort);
        for i := 0 to 3 do FEditors[i].SetRange(0,255);        
        FPort.SetRange( 0,65535);
        FPort.Visible := false;
        FIpe1.FNext := FIpe2;
        FIpe2.FNext := FIpe3;
        FIpe3.FNext := FIpe4;
        FIpe4.FNext := FPort;
        FIpe2.Fprev := FIPe1;
        FIpe3.Fprev := FIPe2;
        FIpe4.Fprev := FIPe3;
        FPort.Fprev := FIPe4;
        calcportsize();
        for i,v in Feditors do V.host := self(true);
        setAddress("127.0.0.1:443");
    end 

    function FontChanged(sender);override;
    begin
        inherited;
        for i,v in FEditors do v.font := font;
        FFontwidth := Font.Width;
        calcportsize();
        InvalidateRect(nil,false);
    end 
    function Paint();override;
    begin
        if not(	FIpe1 and FIpe2 and FIpe3 and FIpe4 and FPort) then return ;
        for i,v in FEditors do v.Paint();
        dc := Canvas;
        dc.font := font;
        for i:=0 to 2+FHasPort do 
        begin
            dc.DrawText(Fsynrects[i,0],Fsynrects[i,1]);
        end     
    end  
    function DoIpChanged();
    begin
        return CallMessgeFunction(onAddrChange,self(true),new tuieventbase(0,0,0,0));
    end 
    function cleanAddr();
    begin
        {**
        @explan(说明)清除地址%%
        **}
        for i,v in FEditors do v.text := "";
    end 
    function setRange(i,low,high);
    begin
        {**
        @explan(说明)设置地址段范围 %%
        @param(low)(integer) 下限 %%
        @param(high)(integer) 上限 %%
        @param(i)(integer) ip段序号 0,1,2,3 %%
        **}
        if i>=0 and i<=4 then 
            FEditors[integer(i)].SetRange(low,high);
    end 
    function DoControlAlign();override;
    begin
        calcportsize();  
    end 
    function MouseUp(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then
                return v.MouseUp(o,e); 
        end  
        return inherited;
    end 
    function MouseMove(o,e);override;
    begin    
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then 
                return v.MouseMove(o,e); 
        end 
        return inherited;
    end 
    function MouseDown(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        idx := -1;
        for i,v in FEditors do 
        begin
            if pointinrect(e.pos,v.GetEntryRect()) then 
            begin 
                idx := i;
                //v.MouseDown(o,e); 
            end else v.KillFocus();
        end 
        if idx>=0 then return FEditors[idx].MouseDown(o,e);
        return inherited;
    end 
    function dosetfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then return v.SetFocus();
        end 
        for i,v in FEditors do 
        begin
            return v.SetFocus();
        end 
        inherited;
    end 
    function dokillfocus(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then return v.killFocus();
        end   
        inherited;    
    end 
    function keypress(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then return v.WMCHAR(o,e);
        end   
        
        inherited;
    end 
    function KeyDown(o,e);override;
    begin
        if csDesigning in ComponentState then return ;
        for i,v in FEditors do 
        begin
            if v.HasFocus then return v.WMKEYDOWN(o,e);
        end   
        inherited;
    end 

    function Recycling();override;
    begin
        FaddrChange := nil;
        FIpe1 := nil;
        FIpe2 := nil;
        FIpe3 := nil;
        FIpe4 := nil;
        FPort := nil;
        for i,v in FEditors do v.Recycling();
        FEditors := array();
        inherited;
    end
    property HasPort:bool read FHasPort write SetHasPort;
    property ipaddr:string  read getAddress write setAddress;
    property onaddrchanged:eventhandler read FaddrChange  write FaddrChange;
    {**
    @param(ipaddr)(string)ip地址%%
    @param(onaddrchanged)(function[tIPAddr,tuieventbase])id地址变化回调%%	
    **} 
    private
    FEditors;
    FHasPort;
    FIpe1;
    FIpe2;
    FIpe3;
    FIpe4;
    FPort;
    FFontwidth;
    FaddrChange;
    Fsynrects;
    function getAddress();
    begin
        r := "";
        for i:= 0 to 3 do 
        begin 
            r+=FEditors[i].GetTureText();
            if i<3 then r+=".";
        end 
        if FHasPort then 
        begin 
            r += ":"+ FPort.GetTureText();
        end 
        return r;
    end 
    function setAddress(v);
    begin
        if not ifstring(v) then return ;
        r := getAddress();
        v1 := str2array(v,":");
        vs := str2array(v1[0],".");
        fipe1.UnLocked := false;
        for i:=0 to min(length(vs)-1,3) do 
            FEditors[i].SetNumValue(StrToIntDef(vs[i],0));
        if v1[1] then 
        begin 
            FPort.SetNumValue(StrToIntDef(v1[1],0)) ;
        end 
        fipe1.UnLocked := true;
        r1 := getAddress();
        if r<>r1 then 
        begin
            DoIpChanged();
        end 
    end
    function SetHasPort(v);
    begin
        nv := v?true:false;
        if FHasPort <>nv then 
        begin 
            FHasPort := nv;            
            calcportsize();
            FPort.Visible := nv;
            InvalidateRect(nil,false);
        end 
    end 
    function calcportsize();
    begin
        if not(	FIpe1 and FIpe2 and FIpe3 and FIpe4 and FPort) then return ;
        rc := ClientRect;
        wd := rc[2]-rc[0]-2;
        h := rc[3]-rc[1]-2;
        if wd<56 then return ;
        ewd := integer((wd-FFontwidth*(3+FHasPort)-10)/(4+FHasPort));
        rc1 := array(1,1,ewd,h);
        FIpe1.ClientRect := rc1;
        rc1 := array(rc1[2]+FFontwidth+1,1,rc1[2]+FFontwidth+ewd,h);
        FIpe2.ClientRect := (rc1);
        rc1 := array(rc1[2]+FFontwidth+1,1,rc1[2]+FFontwidth+ewd,h);
        FIpe3.ClientRect := (rc1);
        if FHasPort then rc1 := array(rc1[2]+FFontwidth+1,1,rc1[2]+FFontwidth+ewd,h);
        else 
            rc1 := array(rc1[2]+FFontwidth+1,1,rc[2],h);
        FIpe4.ClientRect := (rc1);
        if FHasPort then 
        begin 
            rc1 := array(rc1[2]+FFontwidth+1,1,rc[2],h);
            FPort.ClientRect := (rc1);
            FPort.visible := true;
        end         
        Fsynrects := array();
        wd+=2;
        ewd := integer((wd-FFontwidth*(3+FHasPort)-10)/(4+FHasPort));
        rc1 := rc;
        rc1[1] := integer(rc1[3]/5);
        rc1[0]:= (FIpe1.ClientRect)[2];;
        rc1[2] := rc1[0]+FFontwidth;
        Fsynrects[0][0] := ".";
        Fsynrects[0][1] := rc1;        
        rc1[0]:= (FIpe2.ClientRect)[2];
        rc1[2] := rc1[0]+FFontwidth;
        Fsynrects[1,0] := ".";
        Fsynrects[1,1] := rc1;
        rc1[0]:= (FIpe3.ClientRect)[2];;
        rc1[2] := rc1[0]+FFontwidth;
        Fsynrects[2,0] := ".";
        Fsynrects[2,1] := rc1;
        rc1[0]:= (FIpe4.ClientRect)[2];;
        rc1[2] := rc1[0]+FFontwidth;
        Fsynrects[3,0] := ":";
        Fsynrects[3,1] := rc1;
    end 
end 
implementation 
type TtoolbuttonActionLink=class(TControlActionLink)
    {**
    @explan(说明) 工具条按钮actionlink %%
    **}
    protected
    procedure AssignClient(AClient);override;
    begin
        {**
        @explan(说明)赋值control %%
        @param(AClient)(TToolButton) %%
        **}
        if AClient is class(TcustomToolButton)then FClient := AClient;
    end
    function IsshortcutLinked();override;
    begin
        return FClient and(Action is CLASS(TCustomAction));
    end 
    function IsCheckedLinked():Boolean;override;
    begin
        return false;
    end
    public
    procedure SetShortCut(const Value:String);override;
    begin
        if IsshortcutLinked() then return FClient.ShortCut := Value;
    end 
    function create(AOwner);override;
    begin
        inherited;
    end

end   
type TTipWnd=class(TCustomControl) //tip窗口
    {**
    @ignore(忽略) %%
    **}
    function Create(AOwner);override;
    begin
        inherited;
        Visible := false;
        WsPopUp := true;
        Enabled := false;
        color := rgb(244,246,224);
        border := false;
        FTip := "";
    end
    function ShowTip();
    begin
        if FTip then
        begin
            if Visible then return;
            xy := array(0,0);
            _wapi.GetCursorPos(xy);
            //left := xy[0]+10;
            //top := xy[1]+10;
            show(SW_SHOWNOACTIVATE); // 
            SetBounds(xy[0]+10,xy[1]+10,FSize[0],FSize[1]);
        end else
        Visible := false;
    end
    Function Paint();override;
    begin
        dc := Canvas;
        dc.DrawText(FTip,self.ClientRect,DT_LEFT .| DT_NOPREFIX);
    end
    property Tip read FTip write SetTip;
    private
    FTip;
    function SetTip(s);
    begin
        if ifstring(s)and s <> FTip then
        begin
            FTip := s;
            wh := GetTextWidthAndHeightWidthFont(s,seLF.font,1);
            //width := wh[0]+5;
            //height := wh[1]+5;
            FSize := array(wh[0]+5,wh[1]+5);
        end
    end
    private
    FSize;
end
type tedoitem = class
    function create(r,s,e,t);
    begin
        freason := r;
        fstart := s;
        fend := e;
        ftext := t;    
    end
    function clone();
    begin
        return new tedoitem(freason,FStart,fend,ftext);
    end  
    freason; //操作
    fstart;  //开始位置
    fend;    //截止位置
    ftext;   //文本
end 
type tedolist = class()
    public
    function create(); 
    begin
        flist := new tnumindexarray();
        flockct := 0;
    end 
    function citem(r,s,e,t);
    begin
        return new tedoitem(r,s,e,t);
    end 
    function lock();
    begin
        flockct++;
    end 
    function unlock();
    begin
        if flockct>0 then 
        begin
            flockct--;
        end 
        return flockct;
    end 
    function push(it); //弹出
    begin
        if flockct then return 0;
        if ifobj(it) then 
        begin
            flist.push(it);
            return 1;
        end 
    end 
    function peak(); //获取
    begin
        len := flist.length();
        if len>0 then 
        begin
            return flist[len-1];
        end 
        return nil;
    end 
    function pop();
    begin
        if flockct=0 then 
            return flist.pop();
        return 0;
    end 
    function clear();
    begin
        if flockct then return ;
        flist.splice(nil,nil,array());
        flockct := 0;
    end 
    function AddChange(r,s,e,t);
    begin
        if ifobj(r) then push(r.clone());
        push(citem(r,s,e,t));
    end 
    property locked read flockct;
    private
    flockct; //计数
    flist; //链表
end 

initialization
{$ifdef linux}
class(tUIglobalData).uisetdata("G_T_TTIMER_",class(TCustomTimer));
{$endif}

end.