unit utslvclgdi;
{**
    @explan(说明) gdi 对象库 %%
    @date(20220507)
**}
interface
uses cstructurelib,utslvclmemstruct,utslvclauxiliary,utslvclbase;
function GetTextWidthAndHeightWidthFont(s,f,mul);
function getdrawablebitmap(w,h,bmp);
function GetGdipStatus(v);
type TGdi = class(TSLUIBASE)
    private
    static GDICache;
    [weakref]FCanvas;
    function SetCanvas(c);
    begin
        FCanvas := c;
        Onchange();
    end
    protected FHandle; //gdi句柄 
    FGdistate;
    FGDIstruct;
    class function sinit();override;
    begin
        if not GDICache then  
        begin
            inherited;
            if _wapi then 
                GDICache := new TResourcescache(_wapi);
        end 
    end
    public
    function HandleAllocated();virtual;
    begin
        return FHandle <> 0 and ifnumber(FHandle);
    end
    function HandleNeeded();virtual;
    begin
        return FHandle;
    end
    function DestroyHandle();virtual;
    begin
        if HandleAllocated()then
        begin
            unreference();
            FHandle := 0;
        end
    end
    function GetGDIinfo();virtual;
    begin
        if not FGDIstruct then
        begin
            FGDIstruct := 1;
        end
        //return array();
    end
    function Onchange();virtual;
    begin
    end
    function GetFormatGdiStr();
    begin
        v := gdiformatstr();
        if ifstring(v)then return getmsgd_Crc32(v);
        return "";
    end
    function reference();virtual;
    begin
        return GDICache.reference(GetFormatGdiStr());
    end
    function addsource(v);virtual;
    begin
        GDICache.addsource(GetFormatGdiStr(),v);
    end
    function unreference();virtual;
    begin
        GDICache.unreference(GetFormatGdiStr());
    end
    
    function destroyresource();virtual;
    begin
        GDICache.destroyresource(GetFormatGdiStr());
    end
    function gdiformatstr();virtual;
    begin
        return 0;
    end
    function create();override;
    begin
        inherited;
        FGdistate := array();
    end
    function Recycling();override;
    begin
        FCanvas := nil;
        DestroyHandle();
        inherited;
    end
    property Canvas read FCanvas write SetCanvas;
    property Handle read HandleNeeded;
end
type Tcustomfont = class(tgdi)
    private
    fdwfacename;
    FHeight;
    FWidth;
    Fescapement;
    Forientation;
    Fweight;
    Fitalic;
    Funderline;
    Fstrikeout;
    Fcharset;
    Foutprecision;
    Fclipprecision;
    Fquality;
    Fpitchandfamily;
    Ffacename;
    FColor;
    FBKColor;
    FBkmode;
    static LOGSTRUCT;
    static LOGSTRUCTarray;
    class function sinit();override;
    begin
        inherited;
        if not LOGSTRUCTarray then
        begin
            LOGSTRUCTarray := array(
                ("height","int",15),
                ("width","int",0),
                ("escapement","int",0),
                ("orientation","int",0),
                ("weight","int",400),
                ("italic","byte",0),
                ("underline","byte",0),
                ("strikeout","byte",0),
                ("charset","byte",134),
                ("outprecision","byte",3),
                ("clipprecision","byte",2),
                ("quality","byte",1),
                ("pitchandfamily","byte",FIXED_PITCH),
                ("facename","char[32]","新宋体"));
            dt := MemoryAlignmentCalculate(LOGSTRUCTarray,1,nil,nil);
            LOGSTRUCT := new tslcstructureobj(dt,nil);
        end
    end
    function SetColor(c);
    begin
        if ifnumber(c)and c <> FColor then
        begin
            FColor := c;
            if Canvas then Canvas.OnFontColorChange();
        end
    end
    function SetbkColor(c);
    begin
        if ifnumber(c)and c <> FBKColor then
        begin
            FBKColor := c;
            if Canvas then Canvas.OnFontbkColorChange();
        end
    end
    function SetbkMode(c);
    begin
        nc :=(c=OPAQUE)?OPAQUE:TRANSPARENT;
        if FBkmode <> nc then
        begin
            FBkmode := nc;
            if Canvas then Canvas.OnFontbkmodeChange();
        end
    end
    function Setheight(v)
    begin
        if ifnumber(v)and v <> Fheight then
        begin
            Fheight := v;
            onchange();
        end
    end
    function Setwidth(v)
    begin
        if ifnumber(v)and v <> Fwidth then
        begin
            Fwidth := v;
            onchange();
        end
    end
    function Setescapement(v)
    begin
        if ifnumber(v)and v <> Fescapement then
        begin
            Fescapement := v;
            onchange();
        end
    end
    function Setorientation(v)
    begin
        if ifnumber(v)and v <> Forientation then
        begin
            Forientation := v;
            onchange();
        end
    end
    function Setweight(v)
    begin
        if not(v=400 or v=700)then return;
        if v <> Fweight then
        begin
            Fweight := v;
            onchange();
        end
    end
    function Setitalic(v)
    begin
        nv := v?true:false;
        if nv <> Fitalic then
        begin
            Fitalic := nv;
            onchange();
        end
    end
    function Setunderline(v)
    begin
        nv := v?true:false;
        if nv <> Funderline then
        begin
            Funderline := nv;
            onchange();
        end
    end
    function Setstrikeout(v)
    begin
        nv := v?true:false;
        if nv <> Fstrikeout then
        begin
            Fstrikeout := nv;
            onchange();
        end
    end
    function Setcharset(v)
    begin
        if ifnumber(v)and v <> Fcharset then
        begin
            Fcharset := v;
            onchange();
        end
    end
    function Setoutprecision(v)
    begin
        if not(v in array(OUT_DEFAULT_PRECIS,OUT_DEVICE_PRECIS,OUT_OUTLINE_PRCIS,OUT_RASTER_PRECIS,
                OUT_STRING_PRECIS,OUT_STROKE_PRECIS,OUT_TT_ONLY_PRECIS,OUT_TT_PRECIS))then return;
        if v <> Foutprecision then
        begin
            Foutprecision := v;
            onchange();
        end
    end
    function Setclipprecision(v)
    begin
        if not ifnumber(v)then return;
        if(v .&(CLIP_DEFAULT_PRECIS .| CLIP_STROKE_PRECIS .| CLIP_MASK .| CLIP_LH_ANGLES .| CLIP_TT_ALWAYS))and v <> Fclipprecision then
        begin
            Fclipprecision := v;
            onchange();
        end
    end
    function Setquality(v)
    begin
        if not(v in array(DEFAULT_QUALITY,DRAFT_QUALITY,PROOF_QUALITY))then return;
        if v <> Fquality then
        begin
            Fquality := v;
            onchange();
        end
    end
    function Setpitchandfamily(v)
    begin
        if not(v in array(DEFAULT_PITCH,FIXED_PITCH,VARIABLE_PITCH,
                FF_DECORATIVE,FF_MODERN,FF_ROMAN,FF_SCRIPT,FF_SWISS))then return;
        if v <> Fpitchandfamily then
        begin
            Fpitchandfamily := v;
            onchange();
        end
    end
    function Setfacename(v)
    begin
        {$ifdef linux}
        
        {$else}
        if not(v in fdwfacename) then 
        begin
            return ;
        end 
        {$endif}
        if ifstring(v)and v <> Ffacename and length(v)<= 32 then
        begin 
            Ffacename := v;
            onchange();
        end
    end
    protected
    function gdiformatstr();override;
    begin
        s := "";
        for i,v in LOGSTRUCTarray do
        begin
            v0 := v[0];
            s += v0;
            s += ":";
            if v0="facename" then
            begin
                s += invoke(self,"f"+v0);
            end else
            vvi := invoke(self,"f"+v0);
            if ifnumber(vvi)then s += inttostr(vvi);
            else s += "0";
            s += ";";
        end
        r := "class:font;"+s;
        return r;
    end
    public
    function HandleNeeded();override;
    begin
        if not HandleAllocated()then
        begin
            hp := reference();
            if not hp then
            begin
                for i,v in LOGSTRUCTarray do
                begin
                    v0 := v[0];
                    LOGSTRUCT._setvalue_(v0,invoke(self,"f"+v0));
                end
                hp := _wapi.CreateFontIndirectA(LOGSTRUCT._getptr_);
                addsource(hp);
            end
            FHandle := hp;
        end
        return FHandle;
    end
    function fontinfo();
    begin
        {**
        @explan(说明) 获得字体信息 %%
        **}
        r := array();
        for i,v in LOGSTRUCTarray do
        begin
            r[v[0]]:= invoke(self,v[0]);
        end
        r["color"]:= color;
        r["bkcolor"]:= bkcolor;
        return r;
    end
    function create();override;
    begin
        inherited;
        fdwfacename := array( "新宋体","宋体","Courier New");
        fheight := 15;
        fwidth := 7;
        fescapement := 0;
        forientation := 0;
        fweight := 400;
        fitalic := 0;
        funderline := 0;
        fstrikeout := 0;
        fcharset := 134;
        foutprecision := 3;
        fclipprecision := 2;
        fquality := 1;
        fpitchandfamily := FIXED_PITCH;
        ffacename := "新宋体";
        FColor := 0;
        Onchange();
    end
    function Onchange();override;
    begin
        if Canvas then Canvas.OnFontChange();
        DestroyHandle();
    end
    function copyfont(f);virtual;
    begin
        {**
        @explan(说明) 字体信息拷贝 %%
        @param(f)(Tcostmtont) 	
        **}
        if not(f is class(Tcustomfont))then exit;
        return SetValues(f.fontinfo());
        val := array();
        for i,v in LOGSTRUCTarray do
        begin
            v0 := v[0];
            fvi := invoke(f,v0);
            val[v0]:= fvi;
        end
        val["color"]:= f.color;
        val["bkcolor"]:= f.bkcolor;
        return SetValues(val);
    end
    function SetValues(vs);virtual;
    begin
        {**
        @explan(说明) 通过数组设置字体属性 %%
        @param(vs)(array)字体信息数据 %%
        **}
        if not ifarray(vs)then exit;
        for i,v in LOGSTRUCTarray do
        begin
            v0 := v[0];
            vsv := vs[v0];
        {$ifdef linux}
        
        {$else}
            if v0="facename" and not(vsv in fdwfacename ) then 
            begin
                continue;
            end 
        {$endif}
            if not ifnil(vsv)then
            begin
                ovi := invoke(self,"f"+v0);
                if ovi <> vsv then
                begin
                    invoke(self,"f"+v0,1,vsv);
                    cg := true;
                end
            end
        end
        vsc := vs["color"];
        if ifnumber(vsc) and (FColor<>vsc) then
        begin
            cg := true;
            SetColor(vsc);
        end
        if cg then Onchange();
        return cg;
    end
    function GetFontWidth();
    begin
        if FWidth>0 then return FWidth;
        return abs(FHeight)/2;
    end
    property height read Fheight write Setheight;
    property width read Fwidth write Setwidth;
    property escapement read Fescapement write Setescapement;
    property orientation read Forientation write Setorientation;
    property weight read Fweight write Setweight;
    property italic read Fitalic write Setitalic;
    property underline read Funderline write Setunderline;
    property strikeout read Fstrikeout write Setstrikeout;
    property charset read Fcharset write Setcharset;
    property outprecision read Foutprecision write Setoutprecision;
    property clipprecision read Fclipprecision write Setclipprecision;
    property quality read Fquality write Setquality;
    property pitchandfamily read Fpitchandfamily write Setpitchandfamily;
    property facename read Ffacename write Setfacename;
    property Color read FColor write SetColor;
    property bkColor read FBKColor Write SetBkColor;
    property bkmode read FBkmode Write SetBkMode;
end
type TFontControl=class(Tcustomfont)
    {**
    @explan(说明) 控件字体 %%
    **}
    private
    [weakref]FControl;
    Function SetControl(v);
    begin
        if(v <> FControl)and(v is class(tcontrol))then
        begin
            FControl := v;
        end
    end
    protected
    function Onchange();override;
    begin
        inherited;
        if FControl then
        begin
            FControl.FontChanged();
        end
    end
    public
    function create();override;
    begin
        inherited;
    end
    function Recycling();override;
    begin
        FControl := nil;
        inherited;
    end
    property Control read FControl write SetControl;
end
type tcustompen=class(tgdi)
    private
    FStyle;
    FColor;
    FWidth;
    static LOGSTRUCT;
    class function sinit();override;
    begin
        inherited;
        if not LOGSTRUCT then 
        begin
            LOGSTRUCTarray := array(("lopenstyle","int",0),
                ("lopnwidth","int",1),
                ("lopnwidth2","int",0),
                ("lopncolor","int",0));
            dt := MemoryAlignmentCalculate(LOGSTRUCTarray,1,nil,nil);
            LOGSTRUCT := new tslcstructureobj(dt,nil);
        end 
    end
    function HandleNeeded();override;
    begin
        if not HandleAllocated()then
        begin
            hp := reference();
            if not hp then
            begin
                if fStyle in array(PS_NULL,PS_SOLID,PS_INSIDEFRAME)then
                begin
                    w := FWidth;
                end else
                w := 0;
                hp := _wapi.CreatePen(FStyle,w,FColor);
                addsource(hp);
            end
            FHandle := hp;
        end
        return FHandle;
    end
    function gdiformatstr();override;
    begin
        return format("class:pen;style:%d;color:%d;width:%d",FStyle,FColor,FWidth);
    end
    function Onchange();override;
    begin
        if Canvas then Canvas.OnPenChange();
        DestroyHandle();
    end
    function SetColor(c);
    begin
        if ifnumber(c)and c <> FColor then
        begin
            Onchange();
            FColor := c;
        end
    end
    function SetStyle(s);
    begin
        if(s in array(0,1,2,3,4,5,6)) and s <> FStyle then
        begin
            Onchange();
            FStyle := s;
        end
    end
    function SetWidth(w);
    begin
        if w >= 0 and w<20 and c <> FWidth then
        begin
            Onchange();
            FWidth := w;
        end
    end
    function copypen(p);
    begin
        {**
        @explan(说明)拷贝pen属性 %%
        @param(p)(tcustompen) 源 %%
        **}
        if p is class(tcustompen)then
        begin
            ps := p.style;
            wd := p.width;
            cl := p.color;
            if ps <> FStyle or wd <> FWidth or cl <> FColor then
            begin
                Onchange();
                FStyle := ps;
                FWidth := wd;
                FColor := cl;
            end
        end
    end
    public
    function create();
    begin
        inherited;
        FStyle := PS_SOLID;
        FWidth := 1;
        FColor := 0;
    end
    property Color read FColor write SetColor;
    property Width read FWidth write SetWidth;
    property Style read FStyle write SetStyle;
end
type tcustombrush=class(tgdi)
    private
    FStyle;
    FColor;
    FHatch;
    static LOGSTRUCT;
    function SetColor(c);
    begin
        if ifnumber(c)and c <> FColor then
        begin
            onchange();
            FColor := c;
        end
    end
    public
    class function sinit();override;
    begin
        inherited;
        if not LOGSTRUCT then
        begin
                  
            LOGSTRUCTarray := array(("lbstyle","int",BS_SOLID),
                    ("lbcolor","int",0),
                    ("lbhatch","intptr",0));
            dt := MemoryAlignmentCalculate(LOGSTRUCTarray,1,nil,nil);
            LOGSTRUCT := new tslcstructureobj(dt,nil);
        end
    end
    function onchange();override;
    begin
        if Canvas then Canvas.OnBrushChange();
        DestroyHandle();
    end
    function HandleNeeded();override;
    begin
        if not HandleAllocated()then
        begin
            hp := reference();
            if not hp then
            begin
                //LOGSTRUCT._setvalue_("lbstyle",FStyle);
                //LOGSTRUCT._setvalue_("lbcolor",FColor);
                //LOGSTRUCT._setvalue_("lbhatch",FHatch);
                //hp := _wapi.CreateBrushIndirect(LOGSTRUCT._getptr_);
                hp := _wapi.CreateSolidBrush(FColor);
                addsource(hp);
            end
            FHandle := hp;
        end
        return FHandle;
    end
    function gdiformatstr();override;
    begin
        return format("class:brush;style:%d;color:%d;hatch:%d",FStyle,FColor,FHatch);
    end
    function create();override;
    begin
        inherited create();
        sinit();
        FStyle := BS_SOLID;
        FHatch := 0;
        FColor := 0;
    end
    function copybrush(b);
    begin
        if b is class(tcustombrush)then
        begin
            if FColor <> b.color then
            begin
                onchange();
                FColor := b.color;
            end
        end
    end
    //property Style read FStyle write SetStyle;
    property Color read FColor write SetColor;
    //property Hatch read FHatch write SetHatch;
end
type TRgn = class(TSLUIBASE)
    {**
    @explan(说明) 区域 %%
    **}
    private
    FHandle;
    function GetHandle();
    begin
        if not HandleAllocated()then FHandle := CreateRgn();
        return FHandle;
    end
    function SetHandle(v);
    begin
        if v <> FHandle then
        begin
            DestroyHandle();
            if ifnumber(v)and v then FHandle := v;
        end
    end
    public
    function Create();override;
    begin
        inherited;
    end
    function HandleAllocated();
    begin
        return FHandle and ifnumber(FHandle);
    end
    function DestroyHandle();
    begin
        if HandleAllocated()then _wapi.DeleteObject(FHandle);
        FHandle := 0;
    end
    function CreateRgn();virtual;
    begin
        return _wapi.createrectrgn(0,0,0,0);
    end
    class function CombineRgn(rgn1,rgn2,f,rgn);
    begin
        {**
        @explan(说明)rgn合并%%
        @param(rgn1)(trgn) 区域1 %%
        @param(rgn2)(trgn) 区域2 %%
        @param(rgn)(trgn) 返回合并后的区域 %%
        @param(f)(integer) 合并方式 RGN_AND RGN_COPY RGN_DIFF RGN_OR RGN_XOR  %%
        @param(integer) 返回  NULLREGION COMPLEXREGION SIMPLEREGION ERROR		
        **}
        if(rgn1 is class(TRGN))and(rgn2 is class(TRGN))then
        begin
            rgn := new TRgn();
            return _wapi.CombineRgn(rgn.Handle,s1.Handle,rgn2.Handle,f);
        end
    end
    function Recycling();override;
    begin
        DestroyHandle();
        inherited;
    end
    property Handle read GetHandle write SetHandle;
end
type TRGNELLIP=class(TRGN) //椭圆
    {**
    @explan(说明)椭圆rgn
    **}
    private
    FRect;
    function SetRect(v);
    begin
        if v <> FRect and ifarray(v) and ifnumber(v[0])and ifnumber(v[1])and v[2]>v[0]and v[3]>v[1] then
        begin
            FRect := v;
            DestroyHandle();
        end
    end
    public
    function create();override;
    begin
        inherited;
        FRect := array(0,0,0,0);
    end
    function CreateRgn();override;
    begin
        return _wapi.CreateEllipticRgn(FRect[0],FRect[1],FRect[2],FRect[3]);
    end
    property Rect read FRect write SetRect;
end
type TRGNRECT=class(TRGNELLIP)
    {**
    @explan(说明)矩形区域%%
			
    **}
    function create();override;
    begin
        inherited;
    end
    function CreateRgn();override;
    begin
        rec := Rect;
        return _wapi.CreateRectRgn(rec[0],rec[1],rec[2],rec[3]);
    end
end
type TRGNRoundRect=class(TRGNELLIP)
    {**
    @explan(说明) RoundRect rgn %%
    **}
    private
    FEllipseWidth;
    FEllipseHeight;
    function SetEllipseWidth(v);
    begin
        if v >= 0 and v <> FEllipseWidth then
        begin
            FEllipseWidth := v;
            DestroyHandle();
        end
    end
    function SetEllipseHeight();
    begin
        if v >= 0 and v <> FEllipseHeight then
        begin
            FEllipseHeight := v;
            DestroyHandle();
        end
    end
    public
    function Create(AOwner);override;
    begin
        inherited;
        FEllipseHeight := 1;
        FEllipseWidth := 1;
    end
    function CreateRgn();override;
    begin
        rec := Rect;
        return _wapi.CreateRoundRectRgn(rec[0],rec[1],rec[2],rec[3],FEllipseWidth,FEllipseHeight);
    end
    property EllipseWidth:integer read FEllipseWidth write SetEllipseWidth;
    property EllipseHeight:integer read FEllipseHeight write SetEllipseHeight;
end
type TRGNPOLY=class(TRGN) //多边形
    {**
    @explan(说明)多边形区域%%	
    **}
    private
    FPoints;
    FImode;
    function pointtovector(pts); //点转换为数组
    begin
        t := array();
        lt := 0;
        if not ifarray(pts)then return array();
        for i,v in pts do
        begin
            if ifarray(v)and ifnumber(v[0])and ifnumber(v[1])then
            begin
                t[lt++]:= v[0];
                t[lt++]:= v[1];
            end
        end
        return t;
    end
    function SetImode(v);
    begin
        if(v in array(1,2))and v <> FImode then
        begin
            FImode := v;
            DestroyHandle();
        end
    end
    function SetPoints(v);
    begin
        if v <> FPoints then
        begin
            FPoints := v;
            DestroyHandle();
        end
    end
    public
    function create(); //点 和填充模式
    begin
        inherited;
        FImode := ALTERNATE;
    end
    function CreateRgn();override;
    begin
        t := pointtovector(FPoints);
        len := length(t);
        if len>5 then return _wapi.CreatePolygonRgn(t,len/2,FImode);
    end
    property Points read FPoints write SetPoints;
    property Imode read FImode write SetImode;
end

type tcustomimage=class(TSLUIBASE)
    {**
    @explan(说明)image类采用gdiflat封装 %%
    **}
    private
    FHandle;
    FGdi;
    Static FImageTypes;
    class function GetFileType(t_);
    begin
        if not(t_ and ifstring(t_))then t := "png";
        else t := lowercase(t_);
        if not(t in array("png","jpeg","bmp","gif","tiff"))then exit;
        vp := FImageTypes[t];
        if vp then return vp;
        dt := MemoryAlignmentCalculate(array((0,"byte[20]",array())),1,nil,nil);
        vp := new tslcstructureobj(dt,nil);
        //messagebox("image/"+t,"123",0);
        nt := _wapi.AnsiToWidChar("image/"+t);
        vvp := _wapi.GetEncoderClsid(nt,vp._getptr_);
        if vvp <>-1 then
        begin
            FImageTypes[t]:= vp;
        end
        return vp;
    end
    function IFhandle(h);
    begin
        return ifnumber(h)and h;
    end
    private
    function ImageToStream(t);
    begin
        {**
        @ignore(忽略) %%
        @explan(说明) image 转换为stream %%
        **}
        if not FHandle then exit;
        vp := GetFileType(t);
        _wapi.CreateStreamOnHGlobal(0,true,st);
        r := gdi.GdipSaveImageToStream(FHandle,st,vp._getptr_,0);
        if r <> 0 then exit;
        return st;
    end
    public
    class function sinit();override;
    begin
        inherited;
        if not ifarray(FImageTypes)then
        begin
            //return ;
            FImageTypes := array();
            for i,v in array("png","jpeg","bmp","gif","tiff") do
            begin
                GetFileType(v);
            end
        end
    end
    function create();
    begin
        inherited;
        FHandle := 0;
        FGdi := new TGdiplusflat();
    end
    function DestroyHandle();
    begin
        {**
        @explan(说明) 销毁句柄 %%
        **}
        if IFhandle(FHandle)then
        begin
            gdi.GdipDisposeImage(FHandle);
        end
        FHandle := 0;
    end
    function Recycling();override;
    begin
        {**
        @explan(说明) 回收 %%
        **}
        DestroyHandle();
        inherited;
    end
    function Destroy();override;
    begin
        inherited;
    end
    function LoadFromstr(p);
    begin  
        if not(ifstring(p) and p) then return -1 ;
        if fileexists("",p) then return  LoadFromFile(p);
        return StringToImage(p);
    end 
    function LoadFromFile(path);
    begin
        {**
        @explan(说明)打开文件 %%
        @param(path)(string) 路径 %%
        **}
        if not ifstring(path)then exit;
        size := filesize("",path); //获取文件大小
        r :=-1;
        if readFile(rwraw(),"",path,0,size,data)then
        begin
            r := StringToImage(data);
        end
        return r;
        //***********GdipLoadImageFromFile 报错****************
        fn := _wapi.AnsiToWidChar(path);
        r := gdi.GdipLoadImageFromFile(fn,hd);
        if hd then
        begin
            DestroyHandle();
            FHandle := hd;
        end
        return r;
    end
    function SavetoFile(p,t);
    begin
        {**
        @explan(说明) 保存到文件%%
        @param(p)(string)路径 %%
        @param(t)(string)类型 ,"png" "bmp" "gif"
        **}
        if not ifstring(p)then return -1;
        if not ifstring(t)then t := "png";
        if not FHandle then return -1;
        vp := GetFileType(t);
        fn := _wapi.AnsiToWidChar(p);
        return Gdi.GdipSaveImageToFile(FHandle,fn,vp._getptr_(),0);
    end
    function ImageToString(t);
    begin
        {**
        @explan(说明) 得到图片内存%%
        @param(t)(string) png bmp %%	
        **}
        if not FHandle then exit;
        /////////整理imagetostring//////////
        vp := GetFileType(t);
        s := gdi.imagetostring(FHandle,vp);
        return s;
    end
    function StringToImage(b);
    begin
        {**
        @explan(说明) 从字符串到图片 %%
        @param(b)(string) 内存 %%
        **}
        if not(b and ifstring(b))then return 3;
        ////////整理//////////////////////
        r := gdi.stringtoimage(b,hd);
        if hd then
        begin
            DestroyHandle();
            FHandle := hd;
        end
        return r;
    end
    function ToHbitmap();
    begin
        {**
        @explan(说明) 转换为bitmap %%
        @return(pointer)
        **}
        if not FHandle then exit;
        gdi.GdipCreateHBITMAPFromBitmap(FHandle,fhbmp,0xffffff);//rgb(255,255,255)
        return fhbmp;
    end
    function FromHBitmap(bmp);
    begin
        {**
        @explan(说明) 从bitmap得到图片 %%
        @param(bmp)(pointer) hbitmap
        **}
        if not(IFhandle(bmp))then exit;
        if bmp=FHandle then exit;
        gdi.GdipCreateBitmapFromHBITMAP(bmp,0,hd);
        if hd then
        begin
            DestroyHandle();
            FHandle := hd;
        end
    end
    function FromHIcon(ico);
    begin
        {**
        @explan(说明) 从hicon得到图片 %%
        @param(ico)(pointer) hicon %%
        **}
        if not(ifnumber(ico)and ico)then exit;
        if bmp=ico then exit;
        gdi.GdipCreateBitmapFromHICON(ico,hd);
        if hd then
        begin
            DestroyHandle();
            FHandle := hd;
        end
    end
    function tohicon();
    begin
        {**
        @explan(说明) 得到hcion %%
        @return(pointer)hicon
        **}
        if not FHandle then exit;
        gdi.GdipCreateHICONFromBitmap(FHandle,hd);
        return hd;
    end
    property Gdi read FGdi;
    property Handle Read FHandle;
    {**
    @param(gdi)(TGdiplusflat) gdi对象 %%
    @param(handle)(pointer) 句柄 %%
    **}
end
type TPicturebase=class(TSLUIBASE)
    {**
    @explan(说明)bitmap,ico基类 %%
    **}
    private
    FImage;
    public
    function Create();override;
    begin
        inherited;
        try
            FImage := new tcustomimage();
        except
            raise "^~^ gdi support err!";
            FImage := 0;
        end;
    end
    function Recycling();override;
    begin
        FImage := nil;
        inherited;
    end
    property Image read FImage;
end
type TcustomBitmap = class(TPicturebase)
    {**
    @explan(说明) bitmap 类 %%
    **}
    private 
    FHandle;
    FId;
    FDestroy;
    FBytes;
    FDIBites;
    FBitmap;
    static FsysBitmaps;
    static FSHDC;
    static FSHDC2;
    class function sinitdc();
    begin
        if not FSHDC then
        begin
            FSHDC := _wapi.CreateCompatibleDC(0);
            FSHDC2 := _wapi.CreateCompatibleDC(0);
        end
    end
    function getvalue(n);
    begin
        case n of
            "bmtype":return FBitmap.bmtype;
            "bmwidth":return FBitmap.bmwidth;
            "bmheight":return FBitmap.bmheight;
            "bmwidthbytes":return FBitmap.bmwidthbytes;
            "bmplanes":return FBitmap.bmplanes;
            "bmbitspixel":return FBitmap.bmbitspixel;
        end
    end

    function setvalue(n,v);
    begin
        case n of 
            "bmtype"          :  FBitmap.bmtype      :=v  ;     
            "bmwidth"         :  FBitmap.bmwidth     :=v  ;
            "bmheight"        :  FBitmap.bmheight    :=v  ;
            "bmwidthbytes"    :  FBitmap.bmwidthbytes:=v  ;
            "bmplanes"        :  FBitmap.bmplanes    :=v  ;
            "bmbitspixel"     :  FBitmap.bmbitspixel :=v  ;
        end ;
    end 
    function SetHandle(h);
    begin
        {**
        @explan(说明) 设置句柄 %%
        **}
        if h=FHandle then exit;
        if HandleAllocated()then DestroyHandle();
        FDIBites := FBytes := "";
        FHandle := h;
        ReadhInfo();
    end
    Function ReadhInfo();
    begin
        {**
        @explan(说明) 获取信息 %%
        **}
        if HandleAllocated()and FBitmap then
        begin
            _wapi.GetObjectA(FHandle,FBitmap._size_(),FBitmap._getptr_());
        end
    end
    function setid(aid);virtual;
    begin
        {**
        @explan(说明) 设置id %%;
        **}
        if aid <> FId then
        begin
            Fid := aid;
            DestroyHandle();
            if ifnumber(aid)then h := loadsysbmp(aid);
            if h then
            begin
                AutoDestroy := false; //不删除
            end else
            begin
                //h := getresourcebyid(aid,array("type":"bmp"));
                if not h then
                begin
                    if Image then
                    begin
                        //echo "\r\nloadok:",
                        Image.LoadFromstr(aid);
                        //echo "\r\n=================readhandle:",Image.Handle;
                        h := Image.ToHbitmap();
                    end
                end
                AutoDestroy := true; //删除
            end
            if h then
            begin
                SetHandle(H);
            end
        end
    end
    protected
    class function loadsysbmp(aid);virtual;
    begin
        {**
        @explan(说明) 获取系统的bitmap句柄 %%
        @param(aid)(menuber of TSystemBitmap) id %%
        @return(hbitmap) 句柄 %%
        **}
        if not ifarray(FsysBitmaps)then FsysBitmaps := array();
        r := FsysBitmaps[aid];
        if r then return r;
        else
        begin
            r := _wapi.LoadBitmapA2(nil,aid);
            FsysBitmaps[aid]:= r;
        end
        return r;
    end
    function DestroyHandle();virtual;
    begin
        {**
        @explan(说明) 析构句柄 %%
        **}
        if HandleAllocated()and FDestroy then _wapi.DeleteObject(FHandle);
        FHandle := 0;
        FBytes := "";
    end
    public
    function HandleAllocated();
    begin
        {**
        @explan(说明) 判断是有句柄 %%
        @return(bool)
        **}
        return ifnumber(FHandle)and(FHandle <> 0);
    end
    function create();override;
    begin
        inherited;
        FBitmap := new TSHBMP(nil);
        FDestroy := true;
    end
    function draw(dc,x,y,flag,rect);
    begin
        {**
        @explan(说明) 粘贴到hdc %%
        @param(dc)(tcustomcanvas) canvas 对象%%	
        @param(x)(integer) canvas 中的x位置%%	
        @param(y)(integer) canvas 中的y位置%%	
        @param(rect)(array) bimap 的范围 array(左上右下)%%	
        @param(flag)(member of TRasterOperationConst) 光栅操作码 %%	
        **}
        if(dc is class(tcustomcanvas))and dc.HandleAllocated()and HandleAllocated()then
        begin
            sinitdc();
            bw1 := FBitmap.bmwidth;
            bh1 := FBitmap.bmheight;
            rc := array(0,0,bw1,bh1);
            if ifarray(rect)then
            begin
                if intersectrect(rc,rect,irect)then rc := irect;
            end
            return _wapi.drawbitmaptodc(FHandle,dc.Handle,x,y,rc,flag,FSHDC);
            oldmp := _wapi.SelectObject(FSHDC,FHandle);
            if not flag then flag := SRCCOPY;
            r := _wapi.BitBlt(dc.handle,x,y,rc[2]-rc[0],rc[3]-rc[1],FSHDC,rc[0],rc[1],flag);
            if oldmp then _wapi.SelectObject(FSHDC,oldmp);
            return r;
        end
    end
    function StretchDraw(dc,drect,flag,brect);
    begin
        {**
        @explan(说明) 粘贴到hdc %%
        @param(dc)(tcustomcanvas) canvas 对象%%	
        @param(drect)(array) canvas 的范围 array(左上右下)%%	
        @param(brect)(array) bimap 的范围 array(左上右下)%%	
        @param(flag)(member of TRasterOperationConst) 光栅操作码 %%	
        **}
        if not(ifarray(drect))then return-1;
        if(dc is class(tcustomcanvas))and dc.HandleAllocated()and HandleAllocated()then
        begin
            sinitdc();
            bw1 := FBitmap.bmwidth;
            bh1 := FBitmap.bmheight;
            rc := array(0,0,bw1,bh1);
            if ifarray(brect)then if intersectrect(rc,brect,irect)then rc := irect;
            return _wapi.drawbitmapstretchtodc(FHandle,dc.Handle,drect,rc,flag,FSHDC);
            oldmp := _wapi.SelectObject(FSHDC,FHandle);
            if not flag then flag := SRCCOPY;
            r := _wapi.StretchBlt(dc.handle,drect[0],drect[1],drect[2]-drect[0],drect[3]-drect[1],FSHDC,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1],flag);
            if oldmp then _wapi.SelectObject(FSHDC,oldmp);
        end
        return r;
    end
    function Readvcon(d);override;
    begin
        {**
        @expaln(说明)读取二进制信息 %%
        **}
        if Image and ifarray(d)and d["type"]="img" then
        begin
            Image.StringToImage(d["data"]);
            bthandle := Image.ToHbitmap();
            SetHandle(bthandle);
            AutoDestroy := true;
            return;
        end
    end
    function tovcon();override;
    begin
        {**
        @expaln(说明)转换为数据 %%
        **}
        r := nil;
        if Image and HandleAllocated()then
        begin
            r := array();
            r["type"]:= "bmp";
            Image.FromHBitmap(FHandle);
            r["type"]:= "img";
            r["data"]:= Image.ImageToString("png");
        end
        return r;
    end
    function CopyRect(x,y,w,h);
    begin
        {**
        @explan(说明) 拷贝位图 %%
        **}
        r := nil;
        if HandleAllocated()then
        begin
            if x<0 or y<0 or w<0 or h<0 then return r;
            if x+wd>FBitmap.bmwidth then return r;
            if y+h>FBitmap.bmheight then return r;
            wd1 := FBitmap.bmwidthbytes/FBitmap.bmwidth;
            r := array();
            r["type"]:= "bmp";
            r["width"]:= w;
            r["bmwidthbytes"]:= wd1 * w;
            r["bmplanes"]:= FBitmap.bmplanes;
            r["bmbitspixel"]:= FBitmap.bmbitspixel;
            r["height"]:= h;
            sbt := BmpBits;
            sbt2 := "";
            setlength(sbt2,wd1 * w * h * 2);
            hr := FBitmap.bmwidthbytes;
            jj := 1;
            sx := x * wd1;
            ex := sx+w * wd1-1; //(x+w)*wd1-1;
            for ri := y to y+h-1 do
            begin
                for ci := sx to ex do
                begin
                    if ri * hr+ci+1>length(sbt)then break;
                    v := sbt[ri * hr+ci+1];
                    sbt2[jj++]:= v;
                end
            end
            r["bytes"]:= sbt2[1:(wd1 * w * h)];
            rt := new tcustombitmap();
            rt.readvcon(r);
            return rt;
        end
        return r;
    end
    function ToBMPFileString();
    begin
        if Image and HandleAllocated()then
        begin
            r := array();
            Image.FromHBitmap(FHandle);
            return Image.ImageToString("bmp");
        end
        return "";
    end
    function ToIcon();
    begin
        {**
        @explan(说明)将位图转换为icon %%
        @return(ticon|nil) 成功返回图标 %%
        **}
        if HandleAllocated()then
        begin
            Image.FromHBitmap(FHandle);
            thandle := Image.tohicon(); //采用gdi+
            if not thandle then return 0;
            r := new tcustomicon();
            r.Handle := tHandle;
            return r;
        end
        return nil;
    end
    function Recycling();override;
    begin
        DestroyHandle();
        FBitmap := nil;
        inherited;
    end
    property id read FId write SetID;
    property Handle:pointer read  FHandle write SetHandle;
    property AutoDestroy:bool read FDestroy write FDestroy;
    //property BmpBits read GetBits;
    //property DIBits read GetDIBits;
    property bmtype index       "bmtype"    read getvalue write setvalue ;
    property bmwidth index      "bmwidth"     read getvalue write setvalue;
    property bmheight index     "bmheight"    read getvalue write setvalue;
    property bmwidthbytes index "bmwidthbytes" read getvalue write setvalue;
    property bmplanes index     "bmplanes"     read getvalue write setvalue;
    property bmbitspixel index  "bmbitspixel" read getvalue write setvalue;
    {**
    @param(id)() 资源id %%
    @param(Handle)() 句柄 %%
    @param(AutoDestroy)() 析构时销毁句柄 %%
    **}
end 
type TcustomIcon = class(TPicturebase)
    private
    {**
    @explan(说明) 图标对象类 %%
    **}
    FHandle;
    FId;
    FMask;
    FDestroy;
    FMaskBMP;
    FColorBMP;
    FHICON;
    FHandleChanged;
    static FSystemIcons;
    function getvalue(n);
    begin
        if not FHICON then return 0;
        if FHandleChanged then ReadhInfo();
        case n of
            "ficon": return FHICON.ficon;
            "xhotspot": return FHICON.xhotspot;
            "yhotspot": return FHICON.yhotspot;
            "hbmmask": return FHICON.yhotspot;
            "hbmcolor": return FHICON.hbmcolor;
        end
    end
    function setvalue(n,v);
    begin
        if not FHICON then return 0;
        if FHandleChanged then ReadhInfo();
        case n of
            "ficon": return FHICON.ficon := v;
            "xhotspot": return FHICON.xhotspot := v;
            "yhotspot": return FHICON.yhotspot := v;
            "hbmmask": return FHICON.yhotspot := v;
            "hbmcolor": return FHICON.hbmcolor := v;
        end
    end
    function SetHandle(h);
    begin
        {**
        @explan(说明) 设置句柄 %%
        **}
        if HandleAllocated()then DestroyHandle();
        FHandle := h;
        FHandleChanged := true;
    end
    function GetMaskBitMap();
    begin
        if FHandleChanged then ReadhInfo();
        return FMaskBMP;
    end
    function GetColorBitMap();
    begin
        if FHandleChanged then ReadhInfo();
        return FColorBMP;
    end
    Function ReadhInfo();
    begin
        {**
        @explan(说明) 获取信息 %%
        **}
        if FHandleChanged and HandleAllocated()and FHICON then
        begin
            _wapi.GetIconInfo(FHandle,FHICON._getptr_());
            FHandleChanged := false;
            if hbmcolor then
            begin
                FColorBMP := new TcustomBitmap();
                FColorBMP.AutoDestroy := true;
                FColorBMP.Handle := hbmcolor;
            end
            if hbmmask then
            begin
                FMaskBMP := new TcustomBitmap();
                FMaskBMP.AutoDestroy := true;
                FMaskBMP.handle := hbmmask;
            end
        end
        FHandleChanged := false;
    end
    function setid(r);
    begin
        {**
        @explan(说明) 设置id %%;
        **}
        if r <> FId then
        begin
            Fid := r;
            DestroyHandle();
            if ifnumber(r)then h := loadsysico(r);
            if h then
            begin
                FDestroy := false;
            end else
            begin
                //h := getresourcebyid(r,array("type":"ico"));
                if not h then
                begin
                    if Image then
                    begin
                        Image.LoadFromstr(r);
                        h := Image.tohicon();
                    end
                end
                FDestroy := true;
            end
            if H then SetHandle(H);
        end
    end
    protected
    class function loadsysico(aid);virtual;
    begin
        if not ifarray(FSystemIcons)then FSystemIcons := array();
        r := FSystemIcons[aid];
        if r then return r;
        r := _wapi.LoadIconA2(nil,aid);
        FSystemIcons[aid]:= r;
        return r;
    end
    function DestroyHandle();virtual;
    begin
        {**
        @explan(说明) 析构句柄 %%
        @return(bool)
        **}
        if HandleAllocated()and FDestroy then _wapi.DestroyIcon(FHandle);
        FBitmap := nil;
        FMaskBMP := nil;
        FColorBMP := nil;
        FHandle := 0;
    end
    public
    function HandleAllocated();
    begin
        {**
        @explan(说明) 判断是有句柄 %%
        **}
        return ifnumber(FHandle)and(FHandle <> 0);
    end
    function create();
    begin
        inherited;
        FHICON := new TSHICON(nil);
        FDestroy := true;
    end
    function Recycling();override;
    begin
        DestroyHandle();
        FHICON := nil;
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    function Tobitmap();
    begin
        {**
        @explan(说明) 将ico转换为bitmap %%
        @return(nil|TcustomBitmap) 
        **}
        if HandleAllocated()and FImage then
        begin
            FImage.FromHIcon(FHandle);
            Hbm := FImage.ToHbitmap();
            if hbm then
            begin
                r := new TcustomBitmap();
                TBitmap.Handle := Hbm;
                return r;
            end
        end
        return nil;
    end
    function readvcon(d);override;
    begin
        if Image and ifarray(d)and d["type"]="img" then
        begin
            Image.StringToImage(d["data"]);
            bthandle := Image.tohicon();
            SetHandle(bthandle);
            AutoDestroy := true;
        end
    end
    function tovcon();override;
    begin
        r := nil;
        if Image and HandleAllocated()then
        begin
            r := array("type":"ico");
            r["ficon"]:= ficon;
            r["type"]:= "img";
            Image.FromHIcon(FHandle);
            r["data"]:= Image.ImageToString("png");
        end
        return r;
    end
    published
    property id read FId write SetID;
    property Handle read FHandle write SetHandle;
    property MaskBMP:tbitmap read GetMaskBitMap;
    property ColorBMP:tbitmap read GetColorBitMap;
    property AutoDestroy read FDestroy write FDestroy;
    property ficon index "ficon" read getvalue write setvalue;
    property xhotspot index "xhotspot" read getvalue write setvalue;
    property yhotspot index "yhotspot" read getvalue write setvalue;
    property hbmmask index "hbmmask" read getvalue write setvalue;
    property hbmcolor index "hbmcolor" read getvalue write setvalue;
    {**
    @param(id)(integer|string) 资源id %%
    @param(Handle)(intptr) 句柄 %%
    @param(MaskBMP)(TcustomBitmap) mask位图 %%
    @param(ColorBMP)(TcustomBitmap) color位图 %%
    @param(AutoDestroy)(bool) 是否自动是否资源 %%
    **}
end

type tcustomcursor=class(tcustomicon)
    {**
    @explan(说明)光标类 %%
    **}
    private
    static FSystemCursors;
    protected
    class function loadsysico(id);override;
    begin
        {**
        @param(id)(member of TSystemCursor) cursor id %%
        @return(pointer) 句柄 %%
        **}
        if not ifarray(FSystemCursors)then FSystemCursors := array();
        r := FSystemCursors[id];
        if r then return r;
        r := _wapi.LoadCursorA2(nil,id);
        if r then FSystemCursors[id]:= r;
        return r;
    end
    public
    function create();override;
    begin
        inherited;
    end
    function show();override;
    begin
        {**
        @explan(说明) 显示光标
        **}
        if HandleAllocated()then
        begin
            //hd := _wapi.SetCursor(_wapi.LoadCursorA2(0,IDC_WAIT));
            hd := _wapi.SetCursor(self.Handle);
            return hd;
        end
    end
    function Recycling();override;
    begin
        inherited;
    end
end
type TCustomImageList=class(tcomponent)
    {**
    @explan(说明) imgelist 类封装 %%
    **}
    private
    FHeight; //高度
    FWidth; //宽度 
    FHandle; //句柄 
    FInitialCount;
    FAutoDestroy; //是否销毁句柄 
    FCGrow;
    FimageCount; //长度
    FOnChange;
    FChanged;
    FBKColor;
    FImages;
    FDrawBimpFirst;
    FBmpItems;
    FBmpAdding;
    function inDesigning();
    begin
        return csDesigning in ComponentState;
    end
    function addbmps();
    begin
        if ifarray(FImages)and FImages["type"]="bmps" then
        begin
            DestroyHandle();
            for i,vi in FImages["items"] do
            begin
                addbmp(vi);
            end
            FChanged := true;
            change();
        end
    end
    function SetImages(v);
    begin
        if v=FImages then exit;
        FImages := v;
        if inDesigning()then
        begin
            //return ;
        end
        addbmps();
    end
    function GetImages();
    begin
        return FImages;
    end
    function change();virtual;
    begin
        {**
        @explan(说明) 修改时的回调 %%;
        **}
        if FChanged and (iffuncptr(FOnChange)) then call(FOnChange,self(true));
        FChanged := false;
    end
    function GetIconSize();
    begin
        {**
        @explan(说明) 获得位图的高度和宽度 %%
        @return(array) array(cx,cy) %%
        **}
        x := y := 0;
        _wapi.ImageList_GetIconSize(FHandle,x,y);
        r := array(x,y);
        return r;
    end
    function setbkcolor(c);
    begin
        if not ifnumber(c)then exit;
        if c <> FBKColor then
        begin
            FBKColor := c;
            if HandleAllocated()then
            begin
                _wapi.ImageList_SetBkColor(FHandle,c);
            end
        end
    end
    function readinfo()
    begin
        {**
        @explan(说明) 读取信息 %%
        **}
        if HandleAllocated()then
        begin
            FimageCount := 0;
            FimageCount := _wapi.ImageList_GetImageCount(FHandle);
            xy := GetIconSize();
            FBKColor := _wapi.ImageList_GetBkColor(FHandle);
            FWidth := xy[0];
            FHeight := xy[1];
        end
    end
    function indexvalidate(i);
    begin
        {**
        @explan(说明) 是否有效 %%
        **}
        return HandleAllocated()and i<FimageCount and i>-0.5;
    end
    function hcreateimagelist();
    begin
        if not HandleAllocated()then
        begin
            hd := _wapi.ImageList_Create(FWidth,FHeight,0x00000001,FInitialCount,FcGrow);
            if hd then
            begin
                _wapi.ImageList_SetBkColor(hd,FBKColor);
                SetHandle(hd);
                FAutoDestroy := true;
                FChanged := true;
                change();
            end
        end
    end
    protected
    function SetHandle(H);
    begin
        {**
        @explan(说明) 设置句柄 %%
        **}
        if h and ifnumber(h)and h <> FHandle then
        begin
            DestroyHandle();
            FHandle := h;
            readinfo();
            FAutoDestroy := true;
        end
    end
    function SetWidth(w);
    begin
        if w>0 and w <> FWidth then
        begin
            FWidth := w;
            FChanged := true;
            DestroyHandle();
            addbmps();
            //if inDesigning()then 
            change();
        end
    end
    function SetHeight(h);
    begin
        if h>0 and FHeight <> h then
        begin
            FHeight := h;
            FChanged := true;
            DestroyHandle();
            addbmps();
            //if inDesigning()then 
            change();
            //if 	not inDesigning() then DestroyHandle();
        end
    end
    function HandleNeeded();
    begin
        if not HandleAllocated()then hcreateimagelist();
        return FHandle;
    end
    public
    function create(Owner);override;
    begin
        FcGrow := 100;
        FWidth := 24;
        FHeight := 24;
        FInitialCount := 100;
        FAutoDestroy := true;
        FimageCount := 0;
        FBKColor :=0xffffff ;//rgb(255,255,255);
        FBmpItems := new tnumindexarray();
        //FDrawBimpFirst := true;
        inherited;
    end
    function HandleAllocated();
    begin
        {**
        @explan(说明) 句柄是否有效 %%
        **}
        return ifnumber(FHandle)and FHandle <> 0;
    end
    function DestroyHandle();
    begin
        {**
        @explan(说明)销毁句柄 %%
        **}
        if HandleAllocated()and FAutoDestroy then _wapi.ImageList_Destroy(FHandle);
        FHandle := 0;
        FimageCount := 0;
        FBmpItems := new tnumindexarray();
    end
    function add(Image,Mask);
    begin
        {**
        @ignore 忽略%% 
        @explan(说明) 添加位图 %%
        **}
        if not FAutoDestroy then exit;
        if not(Image is class(tcustombitmap))then exit;
        HandleNeeded();
        r :=-1;
        if mask is class(tcustombitmap)then
        begin
            r := _wapi.ImageList_Add(FHandle,Image.Handle,Mask.Handle);
        end else
        if ifnumber(mask)then
        begin
            r := _wapi.ImageList_AddMasked(FHandle,Image.Handle,Mask);
        end else
        r := _wapi.ImageList_Add(FHandle,Image.Handle,nil);
        if r>-0.5 then
        begin
            FimageCount := _wapi.ImageList_GetImageCount(FHandle);
        end
        return r;
    end
    function addbmp(bmp);
    begin
        {**
        @explan(说明) 添加bitmap 到imagelist %%
        @param(bmp)(tcustombitmap) %%
        **}
        if not FAutoDestroy then exit;
        if not(bmp is class(tcustombitmap))then exit;
        HandleNeeded();
        if not(HandleAllocated())then exit;
        ct := FimageCount;
        FBmpAdding := true;
        try
            addIcon(bmp.ToIcon());
            if FimageCount>ct then
            begin
                //////////////拷贝bitamp不销毁///////////////////
                nbmp := new tcustombitmap();
                bmp.AutoDestroy := false;
                nbmp.Handle := bmp.Handle;
                nbmp.AutoDestroy := true;
                //////////////////////////////
                FBmpItems.push(nbmp);
            end
        finally
            FBmpAdding := false;
        end;
    end
    function addIcon(ico);
    begin
        {**
        @explan(说明) 添加图标 %%;
        **}
        if not(ico is class(tcustomicon))then exit;
        if not(ico.HandleAllocated())then exit;
        HandleNeeded();
        if not(HandleAllocated())then exit;
        h := Handle;
        _wapi.ImageList_ReplaceIcon(h,-1,ico.Handle);
        ct := FimageCount;
        FimageCount := _wapi.ImageList_GetImageCount(h);
        if not FBmpAdding then
        begin
            if FimageCount>ct then
            begin
                FBmpItems.push(ico.Tobitmap());
            end
        end
        return;
    end
    function draw(i,dc,x,y,flag);
    begin
        {**
        @explan(说明) 绘制imge %%
        @param(i)(integer) 序号 %%
        @param(dc)(tcustomcanvas) dc 对象 %%
        @param(x)(integer) x坐标 %%
        @param(y)(integer) y坐标 %%
        @param(flag)(member  of TImageListDrawStyle) 标记 %%
        **}
        if not(dc is class(tcustomcanvas))then exit;
        if not dc.HandleAllocated()then exit;
        if indexvalidate(i)then
        begin
            if not(flag >= 0)then flag := ILD_NORMAL;
            if DrawBimpFirst then
            begin
                bmp := FBmpItems[i];
                if bmp then
                begin
                    rc := array(x,y,x+height,y+width);
                    bmp.StretchDraw(dc,rc,(flag=ILC_COLOR4?SRCAND:nil)); //
                end else
                begin
                    _wapi.ImageList_Draw(Fhandle,i,DC.Handle,x,y,flag);
                end
            end else
            begin
                _wapi.ImageList_Draw(Fhandle,i,DC.Handle,x,y,flag);
            end
        end
    end
    function Removeimge(i);
    begin
        {**
        @explan(说明) 删除 %%
        **}
        if indexvalidate(i)then
        begin
            if _wapi.ImageList_Remove(FHandle,i)then
            begin
                FBmpItems.splices(i,1);
                FimageCount--;
            end
        end
    end
    function Replaceimge(i,btmap,msk);
    begin
        {**
        @explan(说明) 替换 image %%
        @param(i)(integer) 位置 %%;
        @param(btmap)(tcustombitmap) 位图 %%
        @param(msk)(tbitmap|hbitmap) mask %%
        **}
        hmsk := 0;
        if indexvalidate(i)then
        begin
            if(btmap is class(tcustombitmap))and(btmap.HandleAllocated())then
            begin
                if(msk is class(tcustombitmap))and(msk.HandleAllocated())then hmsk := msk.Handle;
                else if ifnumber(mask)then hmsk := mask;
                if _wapi.ImageList_Replace(FHandle,i,btmap.Handle,hmsk)then
                begin
                    FBmpItems.splices(i,1,array(btmap));
                end
            end
        end
    end
    function GetIcon(i,flag);
    begin
        {**
        @explan(说明) 获取ticon 对象 %%
        @param(i)(integer) 序号 %%
        @param(flag)(member of TImageListDrawStyle) 样式 %%
        **}
        if HandleAllocated()and i<FimageCount and i>-0.5 then
        begin
            hi := _wapi.ImageList_GetIcon(FHandle,i,flag);
            if hi then
            begin
                r := new tcustomicon();
                r.handle := hi;
                r.AutoDestroy := true;
                return r;
            end
        end
    end
    function loadfromsysbmp(id,cx,cGrow);
    begin
        {**
        @ignore 忽略 %%
        @explan(说明) 导入系统位图生成imagelist %%
        **}
        hd := _wapi.ImageList_LoadImageA2(nil,id,cx,cGrow,CLR_NONE,IMAGE_BITMAP,LR_SHARED);
        SetHandle(hd);
    end
    function GetHotSpot();virtual;
    begin
        return array(0,0);
    end
    function Recycling();override;
    begin
        DestroyHandle();
        FOnChange := nil;
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    function SetSysImageListHandle(h);
    begin
        {**
        @ignore 忽略 %%
        @explan(说明) 设置构造好的iamgelist 到对象,默认不销毁 %%
        **}
        if h <> FHandle then
        begin
            SetHandle(H);
            FAutoDestroy := false;
        end
    end
    published
    property Handle read HandleNeeded write SetHandle;
    property AutoDestroy read FAutoDestroy write FAutoDestroy;
    property ImageCount read FimageCount;
    property Height read FHeight write Setheight;
    property Width read FWidth write SetWidth;
    property imgHeight:integer read FHeight write Setheight;
    property imgWidth:integer read FWidth write SetWidth;
    property OnChange read FOnChange write FOnChange;
    property BkColor:COLORREF read FBKColor write setbkcolor;
    property Images:imagesdata read GetImages write SetImages;
    property DrawBimpFirst read FDrawBimpFirst write FDrawBimpFirst;  
    {**
    @param(Handle)(HIMAGELIS) imagelist句柄 %%
    @param(AutoDestroy)(bool) 是否销毁句柄 %%
    @param(ImageCount)(integer) 图标数量 %%
    @param(OnChange)(function[TCustomImageList]) 改变时的回调 %%
    **}
end
type tcustomcontrolimagelist=class(TCustomImageList)
    {**
    @explan(说明) 控件imagleit %%
    **}
    private
    FImageControls;
    public
    function HandleChanged();virtual;
    begin
        {**
        @explan(说明) 句柄发生变化 %%
        **}
        for i := 0 to FImageControls.Count-1 do
        begin
            FImageControls[i].ImageChanged();
        end
    end
    function create(AOwner);override;
    begin
        inherited;
        FImageControls := new TFpList();
        OnChange := thisfunction(HandleChanged);
    end
    function addControl(v);
    begin
        id := FImageControls.indexof(v);
        if id=-1 then
        begin
            FImageControls.append(v);
        end
    end
    function deleteControl(v);
    begin
        {**
        @explan(说明) 删除控件 %%
        **}
        id := FImageControls.indexof(v);
        if id >= 0 then
        begin
            v.ImageList := nil; //设置为空 
            FImageControls.deli(id);
        end
    end
    function Recycling();override;
    begin
        {**
        @explan(说明) 回收空间%%
        **}
        while FImageControls.Count>0 do
        begin
            deleteControl(FImageControls[0]);
        end
        inherited;
    end
end
type TcustomCanvas = class(TSLUIBASE)
    {**
    @explan(说明) 画布对象 %%
    **}
    private
    FHandle;
    FFont;
    FBrush;
    FPen;
    FState;
    FTEXTMETRICA;
    FSaveGdi;
    FRgn;
    FCounter;
    FTabLength;
    FTabLenParam;
    _xformobj;
    static FHDC;
    type TCounter=class
        private
        FCurrentId;
        public
        function clean();
        begin
            FCurrentId := 0;
        end
        function Create();
        begin
            FCurrentId := 0;
        end
        function InCrease();
        begin
            FCurrentId++;
        end
        function DeCrease();
        begin
            if FCurrentId>0 then FCurrentId--;
        end
        property CurrenId read FCurrentId;
    end
    function SetTextTabLen(v);
    begin
        nv := integer(v);
        if nv <> FTabLength then
        begin
            FTabLength := nv;
            if not FTabLenParam then FTabLenParam := new Ttagdrawtextparams();
            FTabLenParam.itablength := nv;
        end
    end
    function SetPen(p);
    begin
        FPen.copypen(p);
    end
    function SetFont(f);
    begin
        if ifarray(f)then
        begin
            FFont.SetValues(f);
        end else
            FFont.copyfont(f);
    end
    function SetBrush(b);
    begin
        FBrush.copybrush(b);
    end
    function SelectObject(hgdi);
    begin
        if HandleAllocated()then
        begin
            return _wapi.SelectObject(FHandle,hgdi);
        end
    end
    function SetHandle(h);
    begin
        if ifnumber(h)then
        begin
            flashhandle();
            if FHandle <> h then
            begin
                FCounter.clean();
            end
            FHandle := h;
            if h then
            begin
                _wapi.GetTextMetricsA(FHandle,FTEXTMETRICA._getptr_);
            end
        end
    end
    function flashhandle();
    begin
        FState := 1+2+4+8+16+32+64;
    end
    function ifrect(rect);
    begin
        return ifarray(rect)and ifnumber(rect[0])and ifnumber(rect[1])and ifnumber(rect[2])and ifnumber(rect[3]);
    end
    function pointtovector(pts); //点转换为数组
    begin
        {**
        @explan(说明) 将两列的二维数组转换为一维数组 %%
        @param(pts)(array) 一维的数组%%
        @return(array) 两列数组 %%
        **}
        {**
        @example(点数组转换为一维数组)
        // array((x1,y1),(x2,y2),(x3,y3)...) => array(x1,y1,x2,y2,x3,y3,...)
        a := array((1,2),(3,4));
        return pointtovector(a);//array(1,2,3,4);
        **}
        t := array();
        lt := 0;
        if not ifarray(pts)then return array();
        for i,v in pts do
        begin
            if ifarray(v)and ifnumber(v[0])and ifnumber(v[1])then
            begin
                t[lt++]:= v[0];
                t[lt++]:= v[1];
            end
        end
        return t;
    end
    public
    function GetTextExtent(s,mul);
    begin
        {**
        @explan(说明) 获得 字符串绘制宽度和高度 %%
        @param(s)(string) 字符串 %%
        @param(mul)(bool) 多行 默认多行true%%
        **}
        r := array(0,0);
        if ifstring(s)and HandleAllocated()then
        begin
            requiregdi();
            if ifnil(mul)then mul := true;
            if mul then
            begin
                ss := str2array(s,"\n");
                if length(ss)then
                begin
                    for i,v in ss do
                    begin
                        ri := array(0,0);
                        vi := trim(v);
                        if not vi then vi := "\r";
                        _wapi.GetTextExtentPoint32A2(FHandle,vi,length(v),ri);
                        r[0]:= max(r[0],ri[0]);
                        r[1]+= ri[1];
                    end
                end
            end else
            _wapi.GetTextExtentPoint32A2(FHandle,s,length(s),r);
        end
        return r;
    end
    function SelectClipRgn(rgn);
    begin
        {**
        @explan(说明) 设置区域 %%
        @param(rgn)(TRgn) 选择区域 %%
        **}
        if rgn=FRgn then exit;
        r := FRgn;
        FRgn := rgn;
        if not HandleAllocated()then exit;
        if FRgn is class(TRgn)then
        begin
            r1 := _wapi.SelectClipRgn(FHandle,FRgn.Handle);
        end else
        begin
            r1 := _wapi.SelectClipRgn(FHandle,nil);
        end
        if r is class(trgn)then return r;
        return r1;
    end
    function create();override;
    begin
        inherited;
        FTabLength := 0;
        FCounter := new TCounter();
        FHandle := 0;
        FState := 0;
        FPen := new tcustompen();
        FPen.Canvas := self;
        FBrush := new tcustombrush();
        FBrush.Canvas := self;
        FFont := new Tcustomfont();
        FFont.Canvas := self;
        FTEXTMETRICA := new ttagTEXTMETRICA();
    end
    function Recycling();override;
    begin
        {**
        @explan(说明)资源回收 %%
        **}
        FBrush.Recycling();
        FPen.Recycling();
        FBrush := nil;
        FPen := nil;
        FState := nil;
        inherited;
    end
    function destroy();override;
    begin
        inherited;
    end
    function HandleAllocated();
    begin
        {**
        @explan(说明) 判断canvas句柄是否构造 %%
        @return(bool)
        **}
        return ifnumber(FHandle)and(FHandle <> 0);
    end;
    procedure requiregdi(rq);
    begin
        {**
        @explan(说明) 初始化gdi对象 如画刷 画笔 等 %%
        **}
        if HandleAllocated()then
        begin
            if FState .& 1 then
            begin
                SelectObject(FPen.Handle);
            end
            if FState .& 2 then
            begin
                SelectObject(FBrush.Handle);
            end
            if FState .& 4 then
            begin
                SelectObject(FFont.Handle);
            end
            if FState .& 8 then
            begin
                _wapi.SetTextColor(FHandle,FFont.Color);
            end
            if FState .& 16 then
            begin
                _wapi.SetBkColor(FHandle,FFont.bkColor);
            end
            if FState .& 32 then
            begin
                _wapi.SetbkMode(FHandle,(FFont.bkmode=OPAQUE)?OPAQUE:TRANSPARENT); //OPAQUE
            end
            if FRgn is class(trgn)then
            begin
                _wapi.SelectClipRgn(FHandle,FRgn.Handle);
            end
            FState := 0;
        end
    end
    function OnFontbkmodeChange();
    begin
        FState .|= 32;
    end
    function OnPenChange();
    begin
        FState .|= 1;
    end
    function OnBrushChange();
    begin
        FState .|= 2;
    end
    function OnFontChange();
    begin
        FState .|= 4;
    end
    function OnFontColorChange();
    begin
        FState .|= 8;
    end
    function OnFontbkColorChange();
    begin
        FState .|= 16;
    end
    function SetViewportOrg(xy);
    begin
        {**
        @explan(说明)设置选择基准点 %%
        @param(xy)(array) array(x,y)%%
        @return(integer)  %%
        **}
        if HandleAllocated()then
        begin
            if not ifarray(xy)then return 0;
            return _wapi.SetViewportOrgEx(FHandle,xy[0],xy[1],nil);
        end
    end
    function SetPixel(xy,colr);
    begin
        {**
        @explan(说明) 画一个像素 %%
        @param(xy)(array) array(x,y)%%
        @param(colr)(integer) 颜色rgb值 %%
        @return(integer)  %%
        **}
        if HandleAllocated()then return _wapi.SetPixel(FHandle,xy[0],xy[1],colr);
    end
    function fillrgn(rgn);
    begin
        {**
        @explan(说明)区域填充 %%
        @param(rgn)(trgn) 区域 %%
        **}
        if not HandleAllocated()then exit;
        if not(rgn is class(TRgn))then exit;
        _wapi.FillRgn(FHandle,rgn.Handle,FBrush.Handle);
    end
    function FillRect(rec); //填充
    begin
        {**
        @explan(说明)填充rect %%
        @param(rec)(array) 区域 array(左,上,右,下)%%
        @param(br)(tcustombrush) 画刷 %%
        **}
        if HandleAllocated()then
        begin
            return _wapi.FillRect(FHandle,(ifrect(rec)?rec:zeros(4)),FBrush.Handle);
        end
    end
    function InvertRect(rec); //反向填充,rec区域,br画刷
    begin
        {**
        @explan(说明)反向填充区域 %%
        @param(rec)(array) 区域 array(左,上,右,下)%%
        **}
        if not HandleAllocated()then exit;
        return _wapi.InvertRect(FHandle,rec,FBrush.Handle);
    end
    function moveto(pos);
    begin
        {**
        @explan(说明)移动当前点%%
        @param(pos)(array) 位置array(x,y) %%
        @return(array) 原来位置 %%
        **}
        ret := array(0,0);
        if not ifarray(pos)then return-1;
        if HandleAllocated()then
        begin
            _wapi.MoveToEx(FHandle,pos[0],pos[1],ret);
        end
        return ret;
    end
    function lineto(pos); //画线
    begin
        {**
        @explan(说明)画线到点%%
        @param(pos)(array) 位置array(x,y) %%
        **}
        if not ifarray(pos)then return-1;
        if HandleAllocated()then
        begin
            requiregdi();
            return _wapi.LineTo(FHandle,pos[0],pos[1]);
        end
    end
    function textout(str,pos); //输出文字,str文字,pos开始位置
    begin
        {**
        @explan(说明)输出文本%%
        @param(str)(string) 字符串 %%
        @param(pos)(array) 位置array(x,y) %%
        **}
        if not ifstring(str)then return 0;
        if not ifarray(pos)then pos := array(0,0);
        if HandleAllocated()then
        begin
            requiregdi();
            return _wapi.TextOutA(FHandle,pos[0],pos[1],str,length(str));
        end
    end
    function drawtext(str,rec,uft); //在区域中绘制文字
    begin
        {**
        @explan(说明)在指定区域上输出文本%%
        @param(str)(string) 绘制的文字 %%
        @param(rec)(array) array(left,top,right,bottom) %%
        @param(uft)(integer) DT_CALCRECT：这个参数比较重要，可以使DrawText函数计算出输出文本的尺寸。
                            如果输出文本有多行，DrawText函数使用lpRect定义的矩形的宽度，并扩展矩形的底部以容纳输出文本的最后一行。
                            如果输出文本只有一行，则DrawText函数改变矩形的右边界，以容纳下正文行的最后一个字符。
                            出现上述任何一种情况，DrawText函数将返回格式化文本的高度，而不是绘制文本。
        DT_CENTER：指定文本水平居中显示。
        DT_VCENTER：指定文本垂直居中显示。该标记只在单行文本输出时有效，所以它必须与DT_SINGLELINE结合使用。
        DT_SINGLELINE：单行显示文本，回车和换行符都不断行。
        %%
        **}
        if not ifstring(str)then return -1;
        if not ifnumber(uft)then uft := DT_NOPREFIX; //默认忽略 &占位符
        if not ifarray(rec)then rec := nil;
        if not str then return 0;
        if HandleAllocated() then
        begin
            requiregdi();
            if FTabLength then
            begin
                return _wapi.DrawTextExA(FHandle,str,length(str),rec,uft .| DT_EXPANDTABS .| DT_TABSTOP,FTabLenParam._getptr_());
            end else
            return _wapi.DrawTextA(FHandle,str,length(str),rec,uft);
            //
        end
    end
    function StretchDraw(rec,bmp);
    begin
        {**
        @explan(说明) 绘制bitmap %%
        @param(rec)(array of integer) array(左,上,右,下) %%
        @param(bmp)(tcustombitmap) 位图 %%
        **}
        if not(bmp is class(tcustombitmap))then exit;
        bmp.StretchDraw(self,rec);
    end
    function DrawBitmap(bmp,p);
    begin
        {**
        @explan(说明)绘制bitmap %%
        @param(bmp)(tcustombitmap) 图标 %%
        @param(p)( array of integer) 位置 array(x,y)
        **}
        if not(bmp is class(tcustombitmap))then return-1;
        if not ifarray(p)then p := array(0,0);
        bmp.draw(self,p[0],p[1]);
    end
    function DrawIcon(ico,p);
    begin
        {**
        @explan(说明)绘制icon %%
        @param(ico)(ticon) 图标 %%
        @param(p)( array of integer) 位置 array(x,y)
        **}
        if HandleAllocated()then
        begin
            if not(ifarray(p)and ifnumber(p[1])and ifnumber(p[0]))then p := array(0,0);
            if(ico is class(tcustomicon))and ico.Handle then return _wapi.DrawIcon(FHandle,p[0],p[1],ico.Handle);
        end
    end
    function draw_rect(); //矩形绘制对象
    begin
        if HandleAllocated() then requiregdi();
        return new tshapeRectangle(self(true));    
    end 
    function draw_roundrect();//圆角矩形绘制对象
    begin
        if HandleAllocated() then requiregdi();
        return new tshaperoundrect(self(true));    
    end 
    function draw_frame(); //frame 绘制对象
    begin
        if HandleAllocated() then requiregdi();
        return new tshapeframe(self(true)); 
    end 
    function draw_ellipse(); //椭圆绘制对象
    begin
        if HandleAllocated() then requiregdi();
        return new tshapeEllipse(self(true));    
    end 
    function draw_arc(); //arc 绘制
    begin
        if HandleAllocated() then requiregdi();
        return new tshapearc(self(true));    
    end 
    function draw_pie(); //饼 绘制
    begin
        if HandleAllocated() then requiregdi();
        return new tshapepie(self(true));    
    end
    function draw_chord(); //玄切绘制
    begin
        if HandleAllocated() then requiregdi();
        return new tshapechord(self(true));
    end 
    function draw_bezier(); //贝塞尔曲线绘制
    begin
        if HandleAllocated() then requiregdi();
        return new tshapeBezier(self(true));
    end 
    function draw(name_,points,f,m);
    begin
        {**
        @explan(说明)gdi画图函数%%
        @param(name_)(string)  图形名称, rectangle 矩形 ;ellipse 椭圆;roundrect 圆角矩形;chord 弧线 ;pie 饼 ;polybezier 贝塞尔 ;polygon多条直线 %%
        @param(points)(array)  点数组 例如 array((0,0),(1,2)) 表述两个点的数组,点的多少根据name_参数确定 %%
        @param(f)(integer)  作图辅助参数 在画弧线的时候会用到的方向 %%
        @param(m)(integer)  在polypolyline 使用表示绘图样式 %%
        **}
        if not HandleAllocated()then return 0;
        requiregdi();
        if not ifstring(name_)then return 0;
        _name_1 := lowercase(name_);
        r := length(points);
        c := mcols(points);
        if not(r>1 and c=2)then return 0;
        if "framecontrol"=_name_1 then
        begin
            if r<2 then return 0;
            nrc := array(points[0][0],points[0][1],points[1][0],points[1][1]);
            ret := _wapi.DrawFrameControl(FHandle,nrc,(f<inf)?f:DFC_BUTTON,(m<inf)?m:DFCS_CHECKED);
        end else
        if "rectangle"=_name_1 then
        begin
            ret := _wapi.Rectangle(FHandle,points[0][0],points[0,1],points[1,0],points[1,1]);
        end else
        if "ellipse"=_name_1 then
        begin
            ret := _wapi.Ellipse(FHandle,points[0,0],points[0,1],points[1,0],points[1,1]);
        end else
        if "roundrect"=_name_1 then
        begin
            if r<3 then return 0;
            ret := _wapi.RoundRect(FHandle,points[0,0],points[0,1],points[1,0],points[1,1],points[2,0],points[2,1]);
        end else
        if "chord"=_name_1 then
        begin
            if r<4 then return 0;
            ret := _wapi.Chord(FHandle,points[0,0],points[0,1],points[1,0],points[1,1],points[2,0],points[2,1],points[3,0],points[3,1]);
        end else
        if "pie"=_name_1 then
        begin
            ret := _wapi.Pie(FHandle,points[0,0],points[0,1],points[1,0],points[1,1],points[2,0],points[2,1],points[3,0],points[3,1]);
        end else
        if "arc"=_name_1 then
        begin
            if len <> 4 then return 0;
            if not ifnil(f)then _wapi.SetArcDirection(FHandle,f);
            ret := _wapi.Arc(FHandle,points[0,0],points[0,1],points[1,0],points[1,1],points[2,0],points[2,1],points[3,0],points[3,1]);
        end else
        if(("polygon"=_name_1)or("polyline"=_name_1))then
        begin
            if r<2 then return 0;
            //pt := pointtovector(points);
            if "polygon"=_name_1 then
            begin
                if r<3 then return 0;
                ret := _wapi.Polygon(FHandle,points,r);
            end else
                ret := _wapi.polyline(FHandle,points,r);
        end else
        if "polypolyline"=_name_1 then
        begin
            if ifarray(f)and(sum(f)=length(points))then
            begin
                //pt := pointtovector(points);
                ret := _wapi.polypolyline(FHandle,points,f,m);
            end
        end else
        if("polybezier"=_name_1)then
        begin
            if r<3 then return 0;
            //pt := pointtovector(points);
            ret := _wapi.PolyBezier(FHandle,points,r);
        end
        return ret;
    end
    
    function CopyBitmap(rect);
    begin
        {**
        @explan(说明) 获取canvas区域到位图 %%
        @param(array of integer) 区域 array(左,上,右,下);
        @return(tcustombitmap|nil) 成功返回位图 %%
        **}
        r := nil;
        {$ifdef linux}
        return r;
        {$endif}
        if not(ifarray(rect)and rect[2]>rect[0]and rect[3]>rect[1])then return r;
        if not HandleAllocated()then return r;
        if not FHDC then FHDC := _wapi.CreateCompatibleDC(0);
        if not FHDC then return r;
        bthandle := _wapi.CreateCompatibleBitmap(_wapi.GetDC(0),w,h);
        if not bthandle then return r;
        oldb := _wapi.SelectObject(FHDC,bthandle);
        _wapi.BitBlt(FHDC,0,0,rect[2]-rect[0],rect[3]-rect[1],FHandle,rect[0],rect[1],SRCCOPY);
        if oldb then _wapi.SelectObject(FHDC,oldb);
        R := new tcustombitmap();
        R.handle := bthandle;
        return r;
    end
    function SetWorldTransform(trans);
    begin
        {**
        @explan(说明)文本旋转%%
        @param(trans)(array)  array(cos,-sin,sin,cos,x,y)%%
        **}
        {$ifdef linux}
        return r;
        {$endif}
        if not _xformobj then 
		          _xformobj := new Ttagxform();   
        _xformobj.em11 := trans[0];
        _xformobj.em12 := trans[1];
        _xformobj.em21 := trans[2];
        _xformobj.em22 := trans[3];
        _xformobj.edx := trans[4];
        _xformobj.edy := trans[5];
        return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
    end
    function SetPolyFillMode(md); //设置填充样式
    begin
        {**
        @explan(说明)设置填充模式 %%
        @param(md)(integer) 填充模式 ALTERNA WINDING %%
        **}
        if HandleAllocated()then if ifnumber(md)then return _wapi.SetPolyFillMode(FHandle,md);
        return-1;
    end
    function SetBkMode(m);
    begin
        {**
        @explan(说明)文本背景样式%%
        @param(m)(integer)  背景样式OPAQUE or TRANSPARENT %%
        **}
        if HandleAllocated()then return _wapi.SetBkMode(FHandle,m);
    end
    function GetBkMode();
    begin
        {**
        @explan(说明)文本背景样式%%
        @return(integer)  背景样式%%
        **}
        if HandleAllocated()then return _wapi.GetBkMode(FHandle);
    end
    function SetTextAlign(fmt);
    begin
        {**
        @explan(说明)文字对其方式%%
        @param(fmt)(integer)  对其方式TA_LEFT;
        TA_RIGHT;
        TA_CENTER;
        TA_TOP;
        TA_BOTTOM;默认左对齐 %%
        **}
        if not ifnumber(fmt)then fmt := _wapi.TA_LEFT;
        if HandleAllocated()then return _wapi.SetTextAlign(FHandle,fmt);
    end
    function ReleaseDC();virtual;
    begin
        //if HandleAllocated() then _wapi.ReleaseDC(FHandle);
    end
    
    {function BeginPath();
    begin
    if HandleAllocated() then return _wapi.BeginPath(FHandle);
    end 
    function EndPath();
    begin
    if HandleAllocated() then return _wapi.EndPath(FHandle);
    end
    function StrokePath();
    begin
    requiregdi();
    if HandleAllocated() then return _wapi.StrokePath(FHandle);
    end
    function FillPath();
    begin
    requiregdi();
    if HandleAllocated() then return _wapi.FillPath(FHandle);
    end
    function StrokeAndFillPath();
    begin
    requiregdi();
    if HandleAllocated() then return _wapi.StrokeAndFillPath(FHandle);
    end}
    function DeleteDC();
    begin
        if HandleAllocated()then _wapi.DeleteDC(FHandle);
        FHandle := 0;
    end
    function SaveDC();
    begin
        {**
        @explan(说明) 保存当前的dc %%
        **}
        if HandleAllocated()then
        begin
            FCounter.InCrease();
            _wapi.SaveDC(FHandle);
        end
    end
    function RestoreDC();
    begin
        {**
        @explan(说明) 还原dc %%
        **}
        if HandleAllocated()then
        begin
            if FCounter.CurrenId>0 then
            begin
                FCounter.DeCrease();
                _wapi.RestoreDC(FHandle,-1);
            end
        end
    end
    property Handle read FHandle write SetHandle;
    property pen read FPen write SetPen;
    property font read FFont write SetFont;
    property brush read FBrush write SetBrush;
    property bkmode write SetBkMode;
    property TextMetric read FTEXTMETRICA;
    property TextTabLength read FTabLength write SetTextTabLen;
    {**
    @param(pen)(tcustompen) 画笔 %%
    @param(brush)(TBRUSH) 画刷 %%
    @param(font)(Tcustomfont) 字体 %%
    @param(bkmode)(integer) 背景样式 OPAQUE or TRANSPARENT 默认  TRANSPARENT %%
    @param(TextMetric)(ttagTEXTMETRICA) 文本样式信息 %%
    **}
end
type TControlCanvs=class(TcustomCanvas)
    function Create();
    begin
        inherited;
    end
    property ClipRect read FClipRect write SetClipRect;
    private
    Function SetClipRect(v);
    begin
        if ifarray(v)and v[0]<v[2]and v[1]<v[3]then
        begin
            FClipRect := v;
        end
    end
    FClipRect;
end
implementation
	/////////////////////////////////
type TResourcescache=class
    {**
    @ignore(忽略) %%
    @explan(说明)gdi资源等的缓存
    **}
    private
    FCache;
    _wapi;
    public
    function create(api);
    begin
        FCache := array();
        _wapi := api;
    end
    function reference(name);virtual;
    begin
        {**
        @explan(说明)引用资源 %%
        @param(name)(string) 资源名称 %%
        **}
        v := Fcache[name];
        if ifarray(v)then
        begin
            Fcache[name,"count"]+= 1;
            return Fcache[name,"value"];
        end
        return 0;
    end
    function unreference(name);virtual;
    begin
        {**
        @explan(说明)取消引用资源 %%
        @param(name)(string) 资源名称 %%
        **}
        v := Fcache[name];
        if ifarray(v)then
        begin
            count := v["count"];
            if count >= 1 then
            begin
                Fcache[name]["count"]-= 1;
                return 1;
            end
            {else 
            begin
            destroyresource(name);
            end}
        end
        return 0;
    end
    function addsource(name,value);virtual;
    begin
        {**
        @explan(说明)添加资源 %%
        @param(name)(string) 资源名称 %%
        @param(value)(obj) 资源值 %%
        **}
        //RETURN ; //不缓存
        v := Fcache[name];
        if not(v)then
        begin
            Fcache[name]["value"]:= value;
            Fcache[name]["count"]:= 1;
            //return 1;
        end else
        begin
            if Fcache[name]["value"]=value then
            begin
                Fcache[name]["count"]++;
            end else
            if value then
            begin
                destroyresource(name);
                return addsource(name,value);
            end
        end
        FCacheLength := length(FCache);
        maxlen := 256;
        if FCacheLength>maxlen then
        begin
            ct := 0;
            rdxs := array();
            for i,v in FCache do
            begin
                if v["count"]=0 then
                begin
                    rdxs[ct++]:= i;
                end
                if FCacheLength-ct <= maxlen then
                begin
                    break;
                end
            end
            for i,v in rdxs do
            begin
                destroyresource(v);
            end
        end
        return 0;
    end
    function destroyresource(name);virtual;
    begin
        {**
        @explan(说明)删除指定的资源 %%
        @param(name)(string) 资源名称 %%
        **}
        v := Fcache[name];
        if v then
        begin
            hd := v["value"];
            reindex(Fcache,array(name:nil));
            _wapi.DeleteObject(hd);
        end
    end
end
type tshape = class()
    function create(dc);
    begin
        fcanvas := dc;    
    end 
    function draw();virtual;
    begin
        return self(true);
    end 
    protected 
    [weakref]fcanvas;
end 
type tsepoint = class()
    function startpoint(p);overload;
    begin
        if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) then 
        begin
            fsp := array(p[0],p[1]);
        end 
        return self(true);
    end 
    function endpoint(p);overload;
    begin
        if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) then 
        begin
            fep := array(p[0],p[1]);
        end 
        return self(true);
    end 
    function startpoint(x,y);overload;
    begin
        return startpoint(array(x,y));
    end 
    function endpoint(x,y);overload;
    begin
       return endpoint(array(x,y));
    end 
    function direct(dir);
    begin
        fdir := dir;
        return self(true);
    end 
    protected 
    fsp;
    fep;
    fdir;
end 
type tshaperect = class()
    function rect(rec);overload;
    begin
        if ifarray(rec) and rec[2]>rec[0] and rec[3]>rec[1] then 
        begin
            frect := array(rec[0],rec[1],rec[2],rec[3]);
        end 
        return self(true);
    end 
    function rect(l,t,r,b);overload;
    begin
        return rect(array(l,t,r,b));
    end 
    protected 
    frect;
end 

type tshapeEllipse = class(tshape,tshaperect)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and frect then 
        begin
            fcanvas._wapi.Ellipse(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]);
        end 
        return inherited;
    end 
end 
type tshapeRectangle = class(tshape,tshaperect)
    function create(dc);
    begin
        inherited;
        froundw := 0;
        froundh := 0;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and frect then 
        begin
            fcanvas._wapi.Rectangle(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]);
        end 
        return inherited;
    end 
end 
type tshaperoundrect = class(tshape,tshaperect)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and frect then 
        begin
            fcanvas._wapi.RoundRect(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],froundw,froundh);
        end 
        return inherited;
    end 
    function setround(w,h);
    begin
        froundw := w;
        froundh := h;
        return self(true);
    end 
    private 
    froundw;
    froundh;
end 
type tshapeframe = class(tshape,tshaperect)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and frect then 
        begin
            fcanvas._wapi.DrawFrameControl(fcanvas.handle,frect,ftype,fstyle);
        end 
        return inherited;
    end 
    function ctltype(fc);
    begin
        ftype := fc;
        return self(true);
    end
    function ctlstate(cs);
    begin
        fstyle := cs;
        return self(true);
    end 
    private 
    ftype;
    fstyle; 
end 
type tshapearc = class(tshape,tshaperect,tsepoint)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then 
        begin
            if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
            fcanvas._wapi.arc(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
        end 
        return inherited;
    end     
end 
type tshapepie = class(tshape,tshaperect,tsepoint)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then 
        begin
            if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
            fcanvas._wapi.pie(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
        end 
        return inherited;
    end 
end
type tshapechord = class(tshape,tshaperect,tsepoint)
    function create(dc);
    begin
        inherited;
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then 
        begin
            if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
            fcanvas._wapi.chord(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
        end 
        return inherited;
    end 
end 
type tshapeBezier = class(tshape)
    function create(dc);
    begin
        inherited;
        fbpoints := array();
    end 
    function draw();override;
    begin
        if fcanvas and fcanvas.HandleAllocated() and fbpoints then 
        begin            
            fcanvas._wapi.PolyBezier(fcanvas.handle,fbpoints,length(fbpoints));
        end 
        return inherited;
    end 
    function startpoint(p);overload;
    begin
        if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) then 
        begin
            fbpoints := array((p[0],p[1]));
        end 
        return self(true);
    end 
    function startpoint(x,y);overload;
    begin
        return startpoint(array(x,y));
    end 
    function addpoints(ps);
    begin
        if ifarray(ps)  then 
        begin
            fbpoints union= ps;    
        end 
        return self(true);
    end 
    private
    fbpoints;
end 
function getresourcebyid(id,options);
begin
    {**
    @explan(说明)获得resource信息%%
    @param(id)(obj) id 对象 %%
    @param(options)(array) 额外参数 %%
    **}
    global G_O_TSWIN32API_;
    w32 := G_O_TSWIN32API_;
    if not w32 then return 0;
    if not ifarray(options)then return 0;
    h := 0;
    if options["type"]="bmp" then
    begin
        if ifnumber(id)then h := w32.LoadBitmapA2(nil,id);
        else if ifstring(id)then
        begin
            //h := w32.LoadImageA(0,id,0,100,100,0x10 .| 0x40);//
            h := w32.LoadImageA(0,id,0,0,0,0x10 .| 0x40); //
            //h := w32.LoadBitmapA(nil,id);
        end
    end else
    if options["type"]="ico" then
    begin
        if ifnumber(id)then h := w32.LoadIconA2(nil,id);
        else if ifstring(id)then h := w32.LoadImageA(0,id,0x1,0,0,0x10);
    end
    return h;
end
function sinitgidplus();
begin
    FGDI := new TGdiplusflat();
    vot := array(
        ("gdiplusversion","int",1),
        ("debugeventcallback","int",0),
        ("suppressbackgroundthread","int",0),
        ("suppressexternalcodecs","int",0));
    og := new ctslctrans(tslarraytocstructcalc(vot));
    ftoken :=-1;
    ig :=-1;
    FGDI.GdiplusStartup(ftoken,og._getptr_,ig);
end
function GetTextWidthAndHeightWidthFont(s,f,mul);
begin
    {**
    @explan(说明) 获得文本在给定字体f下的绘制宽高 %%
    @param(s)(string) 文本 %%
    @param(f)(tfont) 给定字体 %%
    @param(mul)(bool) 是否多行文本 %%
    **}
    if ifstring(s)and s then
    begin
        cv := static GetOneCanvas();
        if f is class(Tcustomfont)then cv.font := f;
        if ifarray(f)and f then cv.font.SetValues(f);
        return cv.GetTextExtent(s,mul);
    end
    return array(0,0);
end
function GetOneCanvas();
begin
    cv := new tcustomcanvas();//(getapplication());
    cv.handle := cv._wapi.CreateCompatibleDC(0);
    return cv;
end
function getdrawablebitmap(w,h,bmp);
begin
    {$ifdef linux}
    return 0; 
    {$endif}
    if w>1 and h>1 then 
    begin 
        cv := static GetOneCanvas();
        api := cv._wapi;
        bmp := new TcustomBitmap();
        bhd :=api.CreateCompatibleBitmap(api.GetDC(0),w,h);
        bmp.handle := bhd;
        api.SelectObject(cv.handle,bhd);
        return cv;
    end 
end 
function GetGdipStatus(v);
begin
    {**
    @explan(说明) 获得gdiflat的运行状态说明 %%
    @param(v)(integer) 状态值 %%
    @return(string) 状态说明 %%
    **}
    vs := static array(
        "Ok",
        "GenericError",
        "InvalidParameter",
        "OutOfMemory",
        "ObjectBusy",
        "InsufficientBuffer",
        "NotImplemented",
        "Win32Error",
        "WrongState",
        "Aborted",
        "FileNotFound",
        "ValueOverflow",
        "AccessDenied",
        "UnknownImageFormat",
        "FontFamilyNotFound",
        "FontStyleNotFound",
        "NotTrueTypeFont",
        "UnsupportedGdiplusVersion",
        "GdiplusNotInitialized",
        "PropertyNotFound",
        "PropertyNotSupported",
        "ProfileNotFound");
    return vs[v];
end
initialization
sinitgidplus();
class(tcustomimage).sinit();
class(tUIglobalData).uisetdata("G_T_BITMAP_",class(TcustomBitmap));
class(tUIglobalData).uisetdata("G_T_ICON_",class(TcustomIcon));
finalization

end.