tslediter/funcext/tvclib/tcontrol.tsf

type tcontrol = class(tcomponent)
{**
    @explan(说明) 界面控件基类 %%
    @date(20220509) %%
**}
///////////平台判断////////
{$ifdef linux}         
    {$define gtkpaint}
    {$define linuxgtk}
{$else}
    {$define gdipaint}
{$endif}
    uses utslvclauxiliary,utslvclmemstruct,utslvclevent,utslvclgdi,utslvclaction,utslvclmenu;
    private //私有变量
    #!begin //members
    STATIC FSIDC;  //控件id生成器
    FActionLink: TControlActionLink;  
    FCanvas: TCanvas; //为可视控件提供画板
    [weakref]FMessagehandle;//消息表
    FtagPAINTSTRUCT; //绘制区域
    
    FAnchors;
    FAnchorBounds;     
    FCaption;//标题 
    FCaptureMouseButtons;//鼠标样式
    FColor;//颜色
    FBKBitmap; //背景图片
    FControlFlags;//控件标记
    FControlStyle;//控件样式
    //FDesktopFont;
    //FDockOrientation;
    FDragCursor;
    FFont; //字体
    FBorder; //边框
    //FHostDockSite: TWinControl;
    //FLastDoChangeBounds: TRect; 
    //FLastDoChangeClientSize: TPoint;
    //FLastResizeClientHeight: integer;
    //FLastResizeClientWidth: integer;
    //FLastResizeHeight: integer;
    //FLastResizeWidth: integer; 	
    weakref
    FOnClick; //点击
    Fonrclick;
    FOnContextPopup;
    FOnDblClick; //双击
    FOnDragDrop;
    FOnDragOver;
    FOnSize;
    FOnMove;
    //FOnEditingDone;
    FOnEndDock; 
    FOnEndDrag;
    FOnMouseDown; //按下
    FOnMouseEnter; //进入
    FMouseEntereded;
    FOnMouseLeave; //离开
    FOnMouseMove; //移动
    FOnPopupMenu;
    FOnMouseUp; //弹起
    FOnMouseWheel; //滚动
    FOnMouseWheelDown; //滚动按下
    FOnMouseWheelUp; //滚动弹起
    //FOnQuadClick; 
    //FOnResize; //
    FOnShowHint;
    FOnStartDock;
    FOnStartDrag;  
    fonfontchanged;  
    //FOnTripleClick;  
    autoref  
    protected //可以重写的函数以及使用的成员变量
    //对齐
    FAlign;//对齐方式
    FUnAlignBounds;    
    [weakref]FParent;// TWinControl; //父节点    
    //FParentBiDiMode;//: Boolean;
    FPopupMenu;//: TPopupMenu;   
    //FIsControl;//: Boolean;
    //FShowHint;//: Boolean;
    FParentColor;//: Boolean;
    FParentFont;//: Boolean;    
    //FParentShowHint;//: Boolean;
    //FAutoSizingAll;//: boolean;
    //FAutoSizingSelf;//: Boolean;
    FEnabled;//: Boolean; //有效
    //FMouseEntered;//: boolean;
    FVisible;//: Boolean;  //可见
    FID; //id
    #!end    
    //位置信息
    FLeft:integer; //左边
    FTop:integer;//: Integer;    //上
    FWidth:integer;
    FHeight:integer; //高度
    FControls;  //子控件
    FControlState; //状态
    FCursor;  //鼠标
    {**
    	@param(FLeft)(integer) 左边 %%
    	@param(FTop)(integer) 上边 %%
    	@param(FWidth)(integer) 宽度 %%
    	@param(FHeight)(integer) 高度 %%
    **}
    function SetAction(Value);virtual;
    begin
        if csDesigning in ComponentState then
        begin
            FActionLink := Value;
            return;
        end
        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
    function getparenttype(); 
    begin
        return class(TWinControl);
    end 
    procedure DoActionChange(Sender:TObject);
    begin
        if Sender=Action then ActionChange(Sender,False);
    end
    function GetAction();virtual;
    begin
        if csDesigning in ComponentState then
        begin
            return FActionLink;
        end
        if FActionLink then
        begin
            return FActionLink.Action;
        end
    end
    function SetEnabled(v);virtual;
    begin
        nv := v?true:false;
        if FEnabled <> nv then
        begin
            FEnabled := nv;
        end
    end
    procedure SetAlign(Value:TAlign);virtual;
    begin
        if not(Value in array(alLeft,alRight,alBottom,alTop,alNone,alClient))then exit;
        if FAlign=Value then exit;
        oalign := FAlign; //旧对齐方式
        FAlign := Value; 
        //调其兄弟节点的位置 %%
        if (FParent is getparenttype()) and FParent.HandleAllocated()then
        begin            
            if (FAlign=alNone) or (oalign = alNone) then
            begin
                if oalign=alClient then //恢复原有
                begin 
                    bds := UnAlignBounds;
                    SetBounds(bds[0],bds[1],bds[2]-bds[0],bds[3]-bds[1]);
                end else  //保存现在
                begin 
                    FUnAlignBounds := BoundsRect;
                end 
            end 
            FParent.DoControlAlign(); //调整位置
        end
    end
    procedure SetAnchors(Value);virtual;
    begin
        if not ifarray(Value)then exit;
        if FAnchors=Value then exit;
        FAnchorBounds := 0;
        val := Value union2 array();
        aks := array(akLeft,akRight,akTop,akBottom);
        for i,v in val do
        begin
            if not(v in aks)then exit;
        end
        FAnchors := val;
    end
    function SetParentFont(v:bool);virtual;
    begin
        nv := v?true:false;
        if FParentFont <> nv then
        begin
            FParentFont := nv;
            FontChanged();
            return 1;
        end
    end
    function SetParentcolor(v:bool);virtual;
    begin
        nv := v?true:false;
        if FParentColor <> nv then
        begin
            FParentColor := nv;
            return 1;
        end
    end
    private //位置,大小,对齐等属性设置函数
    function SetUnAlignBounds(Value);
    begin
        {**
        @explan(说明) 设置非对齐的范围 %%
        **}
        if(align in array(alTop,alLeft,alRight,alBottom,alClient))then exit;
        if CheckArrayIsControlBounds(Value)and FUnAlignBounds <> Value then
        begin
            FUnAlignBounds := Value;
            if parent and(Align <> alNone)and Parent.HandleAllocated()then Parent.DoControlAlign();
        end
    end
    Function GetUnAlignBounds();virtual; //type_tcontrol
    begin
        {if alNone=FAlign then
        begin
            FUnAlignBounds := GetBoundsRect();
        end}
        if not ifarray(FUnAlignBounds)then FUnAlignBounds := GetBoundsRect();
        return FUnAlignBounds;
    end
    function GetEnabled();virtual;
    begin
        return FEnabled;
    end
    
    procedure SetLeft(Value:Integer); //type_tcontrol
    begin
        if Value>-5000000 and Value<5000000 and Value <> FLeft then SetBounds(Value,FTop,FWidth,FHeight);
    end
    procedure SetTop(Value:Integer); //type_tcontrol
    begin
        if Value>-5000000 and Value<5000000 and Value <> FTop then SetBounds(FLeft,Value,FWidth,FHeight);
    end
    procedure SetWidth(Value:Integer); //type_tcontrol
    begin
        if Value>-5000000 and Value<5000000 and Value <> FWidth then SetBounds(FLeft,FTop,Max(0,Value),FHeight);
    end
    procedure SetHeight(Value:Integer); //type_tcontrol
    begin
        if Value>-5000000 and Value<5000000 and Value <> FHeight then SetBounds(FLeft,FTop,FWidth,Max(0,Value));
    end
    function GetText(); //type_tcontrol
    begin
        return RealGetText();
    end
    procedure SetText(Value:string); //type_tcontrol
    begin
        return RealSetText(Value);
    end
    public
    function PaintStruct();
    begin
        {**
        @explan(说明) 获取绘制消息结对象 %%
        @return(TPAINTSTRUCT) 包含绘制
        **}
        if not FtagPAINTSTRUCT then
        begin
            FtagPAINTSTRUCT := new TPAINTSTRUCT();
        end
        return FtagPAINTSTRUCT;
    end
    function bindmessage(id,func); //绑定事件
    begin
        {**
        @ignore 忽略 %% 
        @explan(说明) 绑定处理函数到消息id %%
        **}
        if not ifarray(FMessagehandle)then FMessagehandle := array();
        if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func;
    end
    private //事件绑定处理
    static FClassDigestA;
    class function CtlInfoAndDigest(idx,d); //通过类的指纹保存或者获取控件信息
    begin
        if not ifarray(FClassDigestA)then FClassDigestA := array();
        if ifnil(d)then return FClassDigestA[idx];
        else FClassDigestA[idx]:= d;
    end
    function FindMessageFunctionstr(o);virtual; //type_tcontrol
    begin
        {
        @explan(说明) 自动绑定消息函数到消息id %%
        }
        if not(o is class(tcontrol))then return array();
        t := o.classinfo;
        idx := getmsgd_Crc32(tostm(t,0,1))+"%%";
        r := CtlInfoAndDigest(idx);
        if ifarray(r)then return r;
        r := array();
        hs := t["inherited"];
        for i,v in hs do
        begin
            //sbf := static  call(thisfunction,findclass(v,o)) name v+"%%_%%"; 
            sbf := call(thisfunction,findclass(v,o));
            for ii,vv in sbf do
            begin
                r[ii]:= vv;
            end
        end
        for i,v in t["subs"] do
        begin
            if v["access"]in array(2,3)then continue;
            fstring := v["functionname"];
            if not ifstring(fstring)then continue;
            //f := findfunction(fstring,o);
            returntype := v["returntype"];
            try
                if returntype then
                begin
                    mid := invoke(o,returntype);
                    r[mid]:= fstring;
                    //bindmessage(mid,f);
                end
            except
            end
        end
        CtlInfoAndDigest(idx,r);
        return r;
    end
    function bindmessages(o);virtual; //type_tcontrol
    begin
        {
        @explan(说明) 自动绑定消息函数到消息id %%
        }
        s := FindMessageFunctionstr(o);
        for i,v in s do
        begin
            bindmessage(i,findfunction(v,o));
        end
    end
    function preparesetparent(np);
    begin
        if (np is getparenttype()) then 
        begin
            if not CheckNewParent(np) then return ;
            if not np.checknewchild(self(true)) then return ;
        end 
        SetParent(np);
    end 
    protected //部分属性设置
    function GetControlFont();virtual;
    begin
        if ParentFont and Parent then return Parent.font;
        return FFont;
    end
    function SetControlFont(v);virtual;
    begin
        if ParentFont then return ; //如果使用父节点的字体,那么字体无效
        if ifarray(v)then
        begin
            FFont.SetValues(v);
        end else
        if v is class(Tcustomfont)then
        begin
            FFont.copyfont(v);
        end
    end
    function SetBorder(v);virtual;
    begin
        FBorder := v?true:false;
    end
    function SetZorder(n);
    begin
        f := Parent;
        if f is getparenttype() then
        begin
            return f.MoveControlOrder(self,n);
        end
    end
    function GetZorder();
    begin
        f := Parent;
        if f is getparenttype()then
        begin
            return f.Controls.indexof(self);
        end
    end
    function RealGetText():TCaption;virtual; //标题
    begin
        return FCaption;
    end
    procedure RealSetText(Value:TCaption);virtual; //标题
    begin
        FCaption := Value;
    end
#!begin  //资源处理		
    function GetCursor();virtual; //鼠标
    begin
        return FCursor;
    end
    procedure SetCursor(Value);virtual;//鼠标
    begin
        if(FCursor is class(tcustomcursor))and ifnumber(Value)and FCursor.id <> Value then
        begin
            FCursor.id := Value;
            Perform(new tuieventbase(CM_CURSORCHANGED,0,0));
        end;
    end
    procedure SetVisible(Value);virtual; //可见
    begin
        FVisible := Value?true:false;
    end
#!end  
    protected //消息对象以及坐标
    function messagecreater(hwnd,message,wparam,lparam);virtual; ////构造消息对象
    begin
        {**
        @explan(说明)根据消息参数构造消息对象;
        **}
        if message in array(WM_MOUSEMOVE,WM_LBUTTONDOWN,
            WM_RBUTTONDOWN,WM_LBUTTONUP,
            WM_RBUTTONUP,WM_LBUTTONDBLCLK,
            WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK)then
        begin
            r := new TMMouse(message,wparam,lparam,hwnd);
        end else
        if message=WM_MENUSELECT then
        begin
            r := new TMMENUSELECT(message,wparam,lparam,hwnd);
        end else
        if message=WM_MEASUREITEM then
        begin
            r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
        end else
        if message in array(WM_KEYDOWN,WM_KEYUP,WM_CHAR,WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP)THEN
        begin
            r := new TMKEY(message,wparam,lparam,hwnd);
        end else
        if message=WM_DRAWITEM then
        begin
            r := new TMDRAWITEM(message,wparam,lparam,hwnd);
        end else
        if message=WM_NOTIFY then
        begin
            r := new TMNOTIFY(message,wparam,lparam,hwnd);
        end else
        if message=WM_MOUSEWHEEL then
        begin
            r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
        end else
        if message=WM_STYLECHANGED or message=WM_STYLECHANGING then
        begin
            r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
        end else
        r := new tuieventbase(message,wparam,lparam,hwnd);
        return r;
        //return new tuieventbase(message,wparam,lparam,hwnd);
    end
    function GetClientOrigin();virtual; ////坐标
    begin
        if FParent then base := FParent.ClientOrigin();
        return array(base[0]+FLeft,base[1]+FTop);
    end
    function GetLogicalClientRect();virtual; //坐标
    begin
        return GetClientRect();
    end;
    function GetClientScrollOffset();virtual; //坐标 
    begin
        return array(0,0);
    end
    function GetScrolledClientRect();virtual; //坐标
    begin
        Result := GetClientRect();
        ScrolledOffset := GetClientScrollOffset();
        Result[0]+= ScrolledOffset[0];
        Result[1]+= ScrolledOffset[1];
        Result[2]+= ScrolledOffset[0];
        Result[3]+= ScrolledOffset[1];
        return Result;
    end;
    function GetControlOrigin();virtual; //坐标
    begin
        Result := array(FLeft,FTop);
        if FParent <> nil then
        begin
            ParentsClientOrigin := FParent.ClientOrigin();
            Result[0]+= ParentsClientOrigin[0];
            Result[1]+= ParentsClientOrigin[1];
        end;
        return Result;
    end
    function ControlAppended(AControl);virtual;//添加控件
    begin
        {**
        @explan(说明) 子控件添加 %%
        **}
        if AControl and AControl.ParentFont then AControl.FontChanged();
    end
    function ControlDeleted(AControl);virtual;//子控件被删除
    begin
        {**
        @explan(说明) 子控件删除 %%
        **}
    end
    function operatectrl(actrl,op); //控件操作通知
    begin
        idx := FControls.indexof(actrl);
        if op=opRemove then
        begin
            if(idx >= 0)then
            begin
                FControls.deli(idx);
                aparent := actrl.FParent;
                actrl.FParent := nil;
                ControlDeleted(actrl);
                //if (actrl.Align<>alNone) and  (aparent is class(TWincontrol)) then aparent.DoControlAlign();
                ifop := true;
            end
        end else
        if op=opInsert then
        begin
            if idx=-1 then
            begin
                wkactl := makeweakref(actrl);
                FControls.append(wkactl);
                actrl.FParent := self(true);
                ControlAppended(wkactl);
                ifop := true;
            end
        end
        return ifop;
    end
    function SetParent(NewParent);virtual; //设置父控件
    begin
        //1.为窗口类
        //2.可以作为父窗口
        //3.调用api 可以成功 
        if NewParent=self then return;
        if NewParent=FParent then return;
        if NewParent is getparenttype() then
        begin
            if FParent then
            begin
                FParent.operatectrl(self(true),opRemove);
            end
            np := NewParent.Parent;
            while np is getparenttype() do
            begin
                if np=self then return;
                np := np.Parent;
            end
            NewParent.operatectrl(self(true),opInsert);
        end else
        begin
            if Parent then FParent.operatectrl(self(true),opRemove);
        end
    end
    procedure SetParentComponent(NewParentComponent);override; //设置父窗口
    begin
        SetParent(NewParentComponent);
    end

    protected  //大小改变
    //procedure UpdateMouseCursor(X, Y: integer); begin    end 
    procedure ChangeBounds(ALeft,ATop,AWidth,AHeight:integer;KeepBase:boolean);virtual; //边界改变
    begin
        if ALeft=-32000 or ATop = -32000 then exit ;
        SizeChanged :=(FWidth <> AWidth)or(FHeight <> AHeight);
        PosChanged :=(FLeft <> ALeft)or(FTop <> ATop);
        if(not SizeChanged)and(not PosChanged)then Exit;
        //   d := new ttagWINDOWPOS();
        d := new tvclwindowpos_class(0);
        if SizeChanged then
        begin
            
            d.cx := AWidth;
            d.cy := AHeight;
            D.flags := SWP_NOMOVE;
            e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_);
            //e := new tuieventbase(WM_SIZE,0,makeposition(AWidth,AHeight));
            class(tcontrol).wndproc(e);
        end
        if PosChanged then
        begin
            d.x := ALeft;
            d.y := ATop;
            d.flags := SWP_NOSIZE;
            e := new tuieventbase(WM_WINDOWPOSCHANGED,0,d._getptr_);
            //e := new tuieventbase(WM_MOVE,6,makeposition( ALeft,ATop));
            class(tcontrol).wndproc(e);
        end
        {if SizeChanged or PosChanged then 
        begin
        if (Parent is class(TWinControl)) and Parent.HandleAllocated then
        begin
        Parent.DoControlAlign();
        end 
        end }
    end
    function MouseHover(o,e);virtual;
    begin
        if not FMouseEntereded then
        begin
            DoMouseEnter(o,e);
            FMouseEntereded := true;
        end
    end
    function MouseLeave(o,e);virtual;
    begin
        if FMouseEntereded then
        begin
            DoMouseLeave(o,e);
            FMouseEntereded := false;
        end
    end
    function defaulthandler(e);virtual;
    begin
        return 0;
    end
    public //鼠标事件
    function MouseMove(o,e);virtual;
    begin
    end
    function MouseDown(o,e);virtual;
    begin
        {**
        @explan(说明) 鼠标按下消息 %%
        @param(o)(TWinControl) 控件自身 %%
        @param(e)(TMMouse) 消息 %%
        **}
    end
    function MouseUp(o,e);virtual;
    begin
        {**
        @explan(说明) 鼠标松开消息 %%
        @param(o)(TWinControl) 控件自身 %%
        @param(e)(TMMouse) 消息 %%
        **}
    end
    function ContextMenu(o,e);virtual;
    begin
        {**
        @explan(说明) 右键菜单 %%
        @param(o)(TWinControl) 控件自身 %%
        @param(e)(tuieventbase) 消息 %%
        **}
        if e.Result then exit;
        if FPopupMenu is class({TcustomPopupmenu}TcustomMenu) then
        begin
            uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
            _wapi.TrackPopupMenu(FPopupMenu.Handle,uf,e.lolparamsigned,e.hilparamsigned,0,e.wparam,nil);
            e.skip := true;
        end
    end
    public//通知
    function Notification(AComponent:TComponent;Operation:TOperation);override; //通知
    begin
        {**
        @explan(说明) 通知消息处理 %%
        **}
        if Operation=opRemove then
        begin
            if AComponent=PopupMenu then 
                PopupMenu := nil ;
            else 
            if AComponent=Action then Action := nil;
            idx := FControls.indexof(AComponent); //删除子控件
            if idx >= 0 then
            begin
                FControls.deli(idx);
            end
        end;
        inherited;
    end;
    procedure FontChanged(Sender:TObject);virtual;
    begin
        //if parent then parent.FontChanged(Sender);
        e := new tuieventbase();
        CallMessgeFunction(fonfontchanged,self(true),e);
    end
    function GetClientRect();virtual; // //type_tcontrol visual size of client area  
    begin
        {**
        @explan(说明) 获取客户区%%
        @return( array of integer) 左上右下 %%
        **}
        return array(0,0,FWidth,Height);
    end

#!begin //消息处理
    function DoCNCOMMAND(o,e);virtual;
    begin
        {**
        @explan(说明) 通知消息 %%
        @param(o)(tcontrol) 控件自身 %%
        @param(e)(tuieventbase) 消息 %%
        **}
    end
    function CNCOMMAND(o,e):CN_COMMAND;virtual;
    begin
        DoCNCOMMAND(o,e);
    end
    function DoMouseEnter(o,e);virtual;
    begin
        {
        @explan(说明) 鼠标进入控件回调 %%
        }
        CallMessgeFunction(FOnMouseEnter,o,e);
    end
    function DoMouseLeave(o,e);virtual;
    begin
        {
        @explan(说明) 鼠标离开控件回调 %%
        }
        CallMessgeFunction(FOnMouseLeave,o,e);
    end
    function DoCnNotify(o,e);virtual;
    begin
        {**
        @expaln(说明) 父窗口通知回调 %%
        **}
    end
    function CNNOTIFY(o,e):CN_NOTIFY;virtual;
    begin
        DoCnNotify(o,e);
    end
    function WMERASEBKGND(o,e):WM_ERASEBKGND;virtual;
    begin
    end
    function WMCancelMode(o,e):LM_CANCELMODE;virtual;
    begin
    end
    function WMContextMenu(o,e):LM_CONTEXTMENU;virtual;
    begin
        CallMessgeFunction(FOnPopupMenu,o,e);
        ContextMenu(o,e);
    end
    function WMLButtonDown(o,e):LM_LBUTTONDOWN;virtual;
    begin
        e.SetButton(mbLeft);
        CallMessgeFunction(FOnMouseDown,o,e);
        MouseDown(o,e);
    end
    function WMRButtonDown(o,e):LM_RBUTTONDOWN;virtual;
    begin
        e.SetButton(mbRight);
        CallMessgeFunction(FOnMouseDown,o,e);
        MouseDown(o,e);
    end
    function WMMButtonDown(o,e):LM_MBUTTONDOWN;virtual;
    begin
        e.SetButton(mbMiddle);
        CallMessgeFunction(FOnMouseDown,o,e);
        MouseDown(o,e);
    end
    function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;virtual;
    begin
        e.SetButton(mbLeft);
        e.setshiftdouble(ssDouble);
        CallMessgeFunction(FOnMouseDown,o,e);
        MouseDown(o,e);     
    end     
    function WMRButtonDBLCLK(o,e):LM_RBUTTONDBLCLK;virtual;
    begin
        {
        @explan(说明) 鼠标右双击击消息 %%
        @param(o)(TWinControl) 控件自身 %%
        @param(e)(TMMouse) 消息 %%
        }
        e.SetButton(mbRight);
        e.setshiftdouble(ssDouble);
        CallMessgeFunction(FOnMouseDown,o,e);
        MouseDown(o,e);
    end
    function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
    begin
        MouseHover(o,e);
    end
    function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
    begin
        MouseLeave(o,e);
    end
    function WMMouseMove(o,e):LM_MOUSEMOVE;virtual;
    begin
        CallMessgeFunction(FOnMouseMove,o,e);
        MouseMove(o,e);
    end
    function WMLButtonUp(o,e):LM_LBUTTONUP;virtual;
    begin
        e.SetButton(mbLeft);
        CallMessgeFunction(FOnMouseUp,o,e);
        MouseUp(o,e);
    end
    function WMRButtonUp(o,e):LM_RBUTTONUP;virtual;
    begin
        e.SetButton(mbRight);
        CallMessgeFunction(FOnMouseUp,o,e);
        MouseUp(o,e);
    end
    function WMMButtonUp(o,e):LM_MBUTTONUP;virtual;
    begin
        e.SetButton(mbMiddle);
        CallMessgeFunction(FOnMouseUp,o,e);
        MouseUp(o,e);
    end
    function DoMouseWheel(o,e);virtual;
    begin
        {**
        @explan(说明) 鼠标滚动消息 %%
        @param(o)(TWinControl) 控件自身 %%
        @param(e)(TMMOUSEWHEEL) 滚动消息 %%
        **}
    end
    function WMMouseWheel(o,e):LM_MOUSEWHEEL;virtual;
    begin
        CallMessgeFunction(FOnMouseWheel,o,e);
        if not e.Result then
        begin
            if e.delta<0 then CallMessgeFunction(FOnMouseWheelDown,o,e);
            else CallMessgeFunction(FOnMouseWheelUp,o,e);
        end
        DoMouseWheel(o,e);
    end
    function DoCNALIGN(o,e);virtual;
    begin
        if FAlign=alNone then exit;
        if not(Visible)then exit;
        if(o is getparenttype())and not(o.HandleAllocated())then
        begin
            exit;
        end
        if e.width<2 or e.height<2 then //处理一下操出范围的子控件
        begin
            case Align of
                alLeft,alRight,alTop,alBottom,alClient:
                begin 
                    SetBounds(e.left,e.top,2,2);    
                end 
            end ;
            exit;
        end 
        bds := UnAlignBounds;
        case Align of
            alTop:
            begin
                ht := min(e.height,bds[3]-bds[1]);
                //if ht then
                //begin
                    SetBounds(e.left,e.top,e.width,max(2,ht));
                    //SetBoundsRect(array(e.left,e.top,e.width+e.left,e.top+ht));
                    e.top += ht;
                    e.height -= ht;
                //end
            end
            alRight:
            begin
                wd := min(e.width,bds[2]-bds[0]);
                SetBounds(e.left+e.width-wd,e.top,max(wd,2),e.height);
                e.width := e.width-wd;
            end
            alLeft:
            begin
                wd := min(e.width,bds[2]-bds[0]);
                SetBounds(e.left,e.top,max(wd,2),e.height);
                e.left := e.left+wd;
                e.width := e.width-wd;
            end
            alBottom:
            begin
                ht := min(e.height,bds[3]-bds[1]);
                SetBounds(e.left,e.top+e.height-ht,e.width,max(ht,2));
                e.height -= ht;
            end
            alClient:
            begin
                SetBounds(e.left,e.top,max(2,e.width),max(2,e.height));
                e.height := 0;
                e.width := 0;
            end
        end
        {if self is class(TWinControl) then 
        begin
        //InvalidateRect(nil,true);	updateWindow();
        end }
    end
    public //消息id绑定相关
    function CNALIGN(o,e):CN_ALIGN;virtual;
    begin
        DoCNALIGN(o,e);
    end
    function CNANCHOR(o,e):CN_ANCHOR;virtual;
    begin
        if Align <> alNone then exit;
        if not ifarray(FAnchors)then exit;
        if not(Visible)then exit;
        if(o is getparenttype())and not(o.HandleAllocated())then
        begin
            exit;
        end
        if akLeft+akTop=sum(FAnchors)then exit; //左上
        c := e.Prec;
        bds := GetBoundsRect();
        if not FAnchorBounds then
        begin
            FAnchorBounds := array(bds[0],bds[1],c[2]-bds[2],c[3]-bds[3]);
            return;
        end
        w := width;
        h := height;
        dx := c[2]-c[0]-(FAnchorBounds[0]+w+FAnchorBounds[2]);
        dy := c[3]-c[1]-(FAnchorBounds[1]+h+FAnchorBounds[3]);
        dx1 := integer(dx/2);
        dx2 := dx-dx1;
        dy1 := integer(dy/2);
        dy2 := dy-dy1;
        L := bds[0];
        r := bds[2];
        t := bds[1];
        b := bds[3];
        if(akLeft in FAnchors)and(akRight in FAnchors)then
        begin
            R := c[2]-FAnchorBounds[2];
        end
        if not(akLeft in FAnchors)and(akRight in FAnchors)then
        begin
            R := c[2]-FAnchorBounds[2];
            L := r-w;
        end
        if not(akLeft in FAnchors)and not(akRight in FAnchors)then
        begin
            L := FAnchorBounds[0]+dx1;
            R := l+w;
        end
        //**********************************
        if(akTop in FAnchors)and(akBottom in FAnchors)then
        begin
            T := FAnchorBounds[1];
            B := c[3]-FAnchorBounds[3];
        end
        if not(akTop in FAnchors)and(akBottom in FAnchors)then
        begin
            B := c[3]-FAnchorBounds[3];
            T := b-h;
            //T := bds[1]+dy;
            //
        end
        if not(akTop in FAnchors)and not(akBottom in FAnchors)then
        begin
            b := c[3]-FAnchorBounds[3]+dy1;
            t := B-h;
        end
        SetBoundsRect(array(L,T,R,B));
        return;
        
    end
    function WMMove(o,e):LM_MOVE;virtual;
    begin
        CallMessgeFunction(OnMove,o,e);
    end
    function DoWMSIZE(o,e);virtual;
    begin
    end
    function WMSize(o,e):LM_SIZE;virtual;
    begin
        CallMessgeFunction(OnSize,o,e);
        DoWMSIZE(o,e);
    end
    function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;
    begin
        //if  SetTempCursor(o.Cursor) then e.skip := true;
        //return ;
        if not(csDesigning in ComponentState)then
        begin
            if SetTempCursor(o.Cursor)then e.skip := true;
        end else
        begin
            cr := new tcustomcursor();
            cr.id := IDC_ARROW;
            if SetTempCursor(cr)then e.skip := true;
        end
    end
    public //暂时不用的消息
    {
    function WMWindowPosChanged(o,e):LM_WINDOWPOSCHANGED;virtual;
    begin
    end
    function CMChanged(o,e):CM_CHANGED;virtual;
    begin
    end
    function LMCaptureChanged(o,e):LM_CaptureChanged;virtual;
    begin
    end
    function CMBiDiModeChanged(o,e):CM_BIDIMODECHANGED;virtual;
    begin
    end
    function CMSysFontChanged(o,e):CM_SYSFONTCHANGED;virtual;
    begin
    end
    function CMEnabledChanged(o,e):CM_ENABLEDCHANGED;virtual;
    begin
    end
    function CMHitTest(o,e):CM_HITTEST;virtual;
    begin
    end
    function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
    begin
    end
    function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
    begin
    end
    function CMHintShow(o,e):CM_HINTSHOW;virtual;
    begin
    end
    function CMParentBiDiModeChanged(o,e):CM_PARENTBIDIMODECHANGED;virtual;
    begin
    end
    function CMParentColorChanged(o,e):CM_PARENTCOLORCHANGED;virtual;
    begin
    end
    function CMParentFontChanged(o,e):CM_PARENTFONTCHANGED;virtual;
    begin
    end
    function CMParentShowHintChanged(o,e):CM_PARENTSHOWHINTCHANGED;virtual;
    begin
    end
    function CMVisibleChanged(o,e):CM_VISIBLECHANGED;virtual;
    begin
    end
    function CMTextChanged(o,e):CM_TEXTCHANGED;virtual;
    begin
    end }

#!end //消息处理		
    protected //key and mouse
    function SetColor(v);virtual;
    begin
        if v <> FColor and ifnumber(v)then
        begin
            FColor := v;
        end
    end
    function getcolor();virtual;
    begin
        if FParentColor and Parent then return Parent.Color;
        return FColor;
    end 
    function SetBitmap(v);virtual;
    begin
        if v <> FBKBitmap then
        begin
            FBKBitmap := v;
        end
    end
    function GetActionLinkClass();virtual;
    begin
        {**
        @explan(说明) 返回actionlinkclass %%
        @return(TControlActionLink class)
        **}
        return class(TControlActionLink);
    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) or Enabled then Enabled := NewAction.Enabled;
            if (not CheckDefaults) or Visible then Visible := NewAction.Visible;
            {
            if not CheckDefaults or (Hint = '') then
            Hint := NewAction.Hint;
            if not CheckDefaults or (Self.HelpContext = 0) then
            Self.HelpContext := HelpContext;
            if not CheckDefaults or (Self.HelpKeyword = '') then
            Self.HelpKeyword := HelpKeyword;
            }
            // HelpType is set implicitly when assigning HelpContext or HelpKeyword
        end;
    end
    //function click(o,e);virtual;begin end
    //function DblClick(o,e);virtual;begin end
    public
    function ScreenToClient(X,Y);virtual;
    begin
        if Parent then
        begin
            ps := Parent.ScreenToClient(x,y);
            return array(ps[0]-Left,ps[1]-Top);
        end
        return array(x,y);
    end
    function ClientToScreen(x,y);virtual;
    begin
        if Parent then
        begin
            ps := array(x+Left,y+Top);
            return Parent.ClientToScreen(x+Left,y+Top);
        end
        return array(x,y);
    end
    function getid();
    begin
        return Fid;
    end
    function create(Owner);override; //构造函数
    begin
        inherited;
        if ifnil(FSIDC)then FSIDC := new tidcreater(100);
        FId := FSIDC.createid();
        //init();
        bindmessages(self(true));
        FControlStyle := array(csCaptureMouse,csClickEvents,csSetCaption,csDoubleClicks);
        FAlign := alNone;
        FAnchors := array(akLeft,akTop);
        FControls := new TFpList();
        FVisible := True;
        FParentBidiMode := True;
        FParentColor := false;
        FParentFont := false;
        //FDesktopFont := True;
        FParentShowHint := True;
        FIsControl := False;
        FEnabled := True;
        FDragCursor := crDrag;
        FCaption := "title";
        FLeft := 10;
        FTop := 10;
        FFont := new TFontControl();
        FFont.Control := self(true);
        FWidth := 120;
        FHeight := 40;
        FBorder := false;
        FColor := 0xffffff; //_wapi.GetSysColor(COLOR_WINDOW);//0xffffff;
        FCanvas := new TControlCanvs();
        FCursor := new tcustomcursor();
        FCursor.id := IDC_ARROW;
    end
    function checknewparent(AParent:TWinControl);virtual; //检查parent 
    begin
        {
        @explan(说明) 判断是否可以作为当前类型的父节点 %%
        @return(bool) 
        }
        return true;
    end
    function checknewchild(achild);virtual;//检查child
    begin
        {
        @explan(说明) 判断是否可以作为当前类型的子节点 %%
        @return(bool) 
        }
        return true;
    end 
    function Recycling();override; //销毁处理
    begin
        {**
        @explan(说明) 资源回收,子类请override该方法然后在destroy中调用 %%
        **}
        FFont := nil;
        FMessagehandle := array();     
        FSIDC.deleteid(FID);
        SetParent(nil);
        //FOnClick := nil; //点击
        //FOnContextPopup := nil;
        //FOnDblClick := nil; //双击
        //FOnDragDrop := nil;
        //FOnDragOver := nil;
        //FOnSize := nil;
        //FOnMove := nil;
        //FOnEditingDone := nil;
        //FOnEndDock := nil;
        //FOnEndDrag := nil;
        //FOnMouseDown := nil; //按下
        //FOnMouseEnter := nil; //进入
        //FMouseEntereded := nil;
        //FOnMouseLeave := nil; //离开
        //FOnMouseMove := nil; //移动
        //FOnPopupMenu := nil;
        //FOnMouseUp := nil; //弹起
        //FOnMouseWheel := nil; //滚动
        //FOnMouseWheelDown := nil; //滚动按下
        //FOnMouseWheelUp := nil; //滚动弹起
        ////FOnQuadClick := nil; 
        ////FOnResize := nil; //
        //FOnShowHint := nil;
        //FOnStartDock := nil;
        //FOnStartDrag := nil;           
        FBKBitmap := nil;
        if FActionLink is class(TControlActionLink)then
        begin
            FActionLink.Recycling();
            FActionLink := nil;
        end
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    function GetBoundsRect(); //type_tcontrol
    begin
        {**
        @explan(说明)获取矩形范围 %%
        **}
        return array(FLeft,FTop,FLeft+FWidth,FTop+FHeight);
    end;
    function SetBoundsRect(rect);
    begin
        {**
        @explan(说明) 设置矩形范围 %%
        **}
        nt := 100000;
        if ifarray(rect)and rect[0]<nt and rect[1]<nt and rect[2]<nt and rect[3]<nt then return SetBounds(rect[0],rect[1],max(rect[2]-rect[0],0),max(0,rect[3]-rect[1]));
    end
    procedure SetBounds(aLeft,aTop,aWidth,aHeight:integer);virtual; //type_tcontrol
    begin
        nt := 100000;
        if aLeft<nt and aTop<nt and aWidth<nt and aHeight<nt and aWidth>0 and aHeight>0 then
        begin
            ChangeBounds(integer(ALeft),integer(ATop),integer(AWidth),integer(AHeight),false);
        end
    end
    function GetBounds();virtual; //type_tcontrol
    begin
        //aLeft, aTop, aWidth, aHeight: integer
        {**
        @explan(说明) 获取控件范围 %%
        @return( array of integer) array(aLeft, aTop, aWidth, aHeight: integer) %%
    			
        **}
        return array(Left,top,Width,height);
        //ChangeBounds(ALeft, ATop, AWidth, AHeight, false);  
    end
    procedure SetTempCursor(Value);virtual;
    begin
        if Parent then return Parent.SetTempCursor(Value);
    end
    // drag and dock 
    function Dragging();
    begin
        //return DragManager.Dragging(Self); 
    end;
    procedure BeginDrag(Immediate:Boolean;Threshold);
    begin
        if not ifnumber(Threshold)then Threshold :=-1;
        //DragManager.DragStart(Self, Immediate, Threshold);  
    end
    procedure EndDrag(Drop:Boolean);
    begin
        //if Dragging() then	DragManager.DragStop(Drop);   
    end
    function dispatch(o,e);virtual; //分发消息
    begin
        {**
        @explan(说明)消息分发函数 %%
        @param(o)()控件自身 %%
        @param(e)(tuieventbase) 消息类及其子类 %%
        **}
        id := e.Msg;
        if ifnumber(id) and FMessagehandle then 
        begin 
            func := FMessagehandle[id];
            if func then call(func,o,e);
        end 
    end
    procedure DoControlAlign();virtual;//调整子控件位置
    begin
    end
    procedure DoControlAnchor();virtual;//调整子控件位置
    begin
    end
    procedure WndProc(TheMessage);virtual; //消息分发
    begin
        {**
        @explan(说明) 消息循环 %%
        @param(e)(tuieventbase) 消息对象 %%
        **}
        TheMessage.Sender := self(true);
        tmsg := TheMessage.msg;
        case tmsg of
            WM_WINDOWPOSCHANGED:
            begin
                rchange := 0;
                d := new tvclwindowpos_class(TheMessage.lparam);
                flags := d.flags;
                //if flags .& SWP_HIDEWINDOW then return ;
                //if flags .& SWP_SHOWWINDOW then return ;
                if d.x=-32000 then return ;
                if d.y=-32000 then return ;
                if not((flags .& SWP_NOMOVE)=SWP_NOMOVE)then
                begin
                    x := d.x;
                    y := d.y;
                    if x <> FLeft then 
                    begin
                        FLeft := x;
                        rchange .|=1;
                    end 
                    if y <> FTop then 
                    begin
                        FTop := y;
                        rchange .|=2;
                    end 
                end
                if not((flags .& SWP_NOSIZE)=SWP_NOSIZE)then
                begin
                    cx := d.cx;
                    cy := d.cy;
                    if cx <> FWidth then 
                    begin
                        FWidth := cx;
                        rchange .|=4;
                    end 
                    if cy <> FHeight then 
                    begin
                        FHeight := cy;
                        rchange .|=8;
                    end 
                end
                if rchange then 
                begin
                    obj := class(tUIglobalData).uigetdata("tuiapplication");
                    if obj then 
                    begin
                        obj.Notification(self(true),array("type":"possize","flag":rchange,"data":array(fleft,ftop,FWidth,FHeight)));
                        //obj.Notification(self(true),new tpossizenote(rchange,fleft,ftop,FWidth,FHeight));
                    end
                    //echo "\r\n note change mtoc:",caption,"===",mtoc; 
                end 
            end
            {WM_SIZE:
            begin	
            x := TheMessage.lolparamsigned();
            dxsize := x-FClientWdith;
            if FClientWdith<> x then  FClientWdith := x;
            y := TheMessage.hilparamsigned();
            dysize := y-FClientHeight;
            if FClientHeight <> y then FClientHeight := y;
            DoControlAnchor(array(dxsize,dysize));	
            DoControlAlign(array(FClientLeft,FClientTop,x,y));
            end 
            WM_MOVE:
            begin
            x :=   TheMessage.lolparamsigned();
            if FClientLeft<> x then  FClientLeft := x;
            y := TheMessage.hilparamsigned();
            if FClientTop <> y then FClientTop := y;
            end }
        end;
        if(csDesigning in ComponentState)then
        begin
            //CallMessgeFunction(,self(true),TheMessage);
        end else
        if(tmsg >= LM_KEYFIRST)and(tmsg <= LM_KEYLAST)then
        begin
            // keyboard messages
            //Form := GetParentForm(Self);
            //if (Form <> nil) and (Form.WantChildKey(Self,TheMessage)) then exit;
        end else
        if((tmsg >= LM_MOUSEFIRST)and(tmsg <= LM_MOUSELAST))or((tmsg >= LM_MOUSEFIRST2)and(tmsg <= LM_MOUSELAST2))then
        begin
            // mouse messages
            case tmsg of
                LM_MOUSEMOVE:
                begin
                    //Application.HintMouseMessage(Self, TheMessage);
                end;
                LM_LBUTTONDOWN,LM_LBUTTONDBLCLK:
                begin
                    includestate(FControlState,csLButtonDown);
                    if FDragMode=dmAutomatic then
                    begin
                    end;
                    //BeginAutoDrag();
                end;
                LM_LBUTTONUP:
                begin
                    excludestate(FControlState,csLButtonDown);
                end;
            end;
        end;
        if tmsg=LM_PAINT then
        begin
            includestate(FControlFlags,cfProcessingWMPaint);
            try
                Dispatch(self(true),TheMessage);
            finally
                excludestate(FControlFlags,cfProcessingWMPaint);            
            end;
        end else
        begin
            Dispatch(self(true),TheMessage);
        end
    end;    
    function Perform(e);
    begin
        {**
        @explan(说明) 消息通知执行 %%
        @param(e)(tuieventbase)
        **}
        WndProc(e);
        return e.Result;
    end
    property ActionLink read FActionLink; //write FActionLink; 
    {public
    procedure AdjustSize;virtual; // smart calling DoAutoSize
    begin
        includestate(FControlFlags,cfAutoSizeNeeded);
        if Parent then
        begin
            Parent.AdjustSize(); //
        end
    end }  
    protected
    property UnAlignBounds read GetUnAlignBounds write SetUnAlignBounds;
    {**
    	@param(Action)(taction) action对象 %%
    	@param(UnAlignBounds)(array of integer) 去除自动对齐时的范围 %%
    	@param(Align)(member of TAlign ) 默认 alNone 对齐方式 %%
    	@param(Anchors)( array of TAnchorKind member) 锚定位置 ,默认 array(akTop,akLeft)  %%
    **} 
    published
    // standard properties, which should be supported by all descendants  
    property Action:taction read GetAction write SetAction;
    property Anchors:anchors read FAnchors write SetAnchors; 
    property Align:align read FAlign write SetAlign;
    property ParentFont:bool read FParentFont write SetParentFont;
    property Parentcolor:bool read FParentcolor write SetParentcolor;
    property Caption:string read GetText write SetText ;  
    property Enabled:bool read GetEnabled write SetEnabled;
    property Cursor:syscursor read GetCursor write SetCursor;
    {**
    	@param(Cursor)(tcursor 通过 member of TSystemCursor 设置) 系统鼠标 %%
    **}
    property Font:font read GetControlFont  write SetControlFont;//write SetFont; 
    property OnMouseWheel read FOnMouseWheel write FOnMouseWheel;
    {**
    	@param(Caption)(string) 控件标题 %%
    	@param(Enabled)(bool) 控件是否有效 %%
    	@param(OnMouseWheel)(function[TControl,TMMOUSEWHEEL]) 滚动回调函数 %%
    **}
    //property MouseEntered read FMouseEntered; 
    property OnSize:eventhandler read FOnSize write FOnSize;
    property OnMove:eventhandler read FOnMove write FOnMove;
    property OnMouseMove:eventhandler read FOnMouseMove Write FOnMouseMove;
    property OnPopupMenu:eventhandler read FOnPopupMenu write FOnPopupMenu;
    property OnMouseDown:eventhandler read FOnMouseDown write FOnMouseDown;
    {**
    	@param(OnMouseMove)(function[TControl,TMMouse]) 鼠标移动回调函数 %%
    	@param(OnPopupMenu)(function[TControl,TMMouse]) 弹出菜单回调函数 %%
    	@param(OnMouseDown)(function[TControl,TMMouse]) 鼠标按下回调函数 %%
    	@param(OnMouseUp)(function[TControl,TMMouse]) 鼠标松开回调函数 %%
    	@param(OnClick)(function[TControl,TMMouse]) 鼠标点击回调函数 %%
    	@param(OnDblClick)(function[TControl,TMMouse]) 鼠标双击回调函数 %%
    	@param(PopupMenu)(tpopupmenu) 弹出菜单%%
    	@param(Parent)(tcontrol) 父控件 %%
    	@param(Visible)(bool) 是否可见 %%
    **}
    property OnMouseUp:eventhandler read FOnMouseUp write FOnMouseUp;
    property onfontchanged:eventhandler read fonfontchanged write fonfontchanged;
    property OnClick:eventhandler	read FOnClick write FOnClick;
    property onrclick:eventhandler read Fonrclick write Fonrclick;
    property OnDblClick:eventhandler	read FOnDblClick write FOnDblClick;
    //property OnResize	read FOnResize write FOnResize;
    property OnShowHint read FOnShowHint write FOnShowHint;
    property Parent read FParent write preparesetparent;
    property PopupMenu:tpopupmenu  read FPopupMenu write FPopupMenu{read GetPopupmenu write SetPopupMenu};
    //property ShowHint	read FShowHint write SetShowHint ;
    property Visible:bool	read FVisible write SetVisible ;
    property ClientRect read GetClientRect;
    property Height: Integer read FHeight write SetHeight; 
    property Width :integer read FWidth write SetWidth;
    property Left :integer read FLeft write SetLeft;
    property Top :integer read FTop write SetTop;
    property Border:bool read FBorder write SetBorder;
    {**
    	@param(ClientRect)(array of integer) 客户区矩形array(left,top,right,bottom) %%
    	@param(BoundsRect)(array of integer) 控件区矩形array(left,top,right,bottom) %%
    	@param(Height)(integer) 高度 %%
    	@param(Width)(integer) 宽度 %%
    	@param(Zorder)(integer) 设置控件在父窗口的次序,最底层为 0 %%
    	@param(Top)(integer) 上方位置 %%
    	@param(Left)(integer) 左边 %%
    **}
    property BoundsRect read GetBoundsRect write SetBoundsRect;
    property Zorder read GetZorder write SetZorder;
    property ControlState: TControlState read FControlState write FControlState; 
    property Color:color read getcolor write  SetColor;//FColor;
    property BKBitmap:tbitmap read FBKBitmap write SetBitmap;
    //property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
    //property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
    property Controls read FControls;
    property Canvas: TCanvas read FCanvas;		
    {**
    	@param(Canvas)(TCanvas) 画布对象 %%
    	@param(Controls)(TFpList of tcontrol) 子组件 %%
    	@param(OnMouseLeave)(function[TControl,tuieventbase]) 鼠标离开回调 %%
    	@param(OnMouseEnter)(function[TControl,tuieventbase]) 鼠标进入回调 %%
    	@param(Color)(integer) 背景色 %%
    **}
    function isCustomPaint(); //提供给gtk使用
    begin
        return csCustomPaint in FControlState ;
    end 
end