界面库

减少c的依赖

designer/udesignerproject.tsf

@@ -364,6 +364,7 @@ type TProjectView = class(TVCForm) //
         imgs := New TControlImageList(self);
         imgs.width := 24;
         imgs.height := 24;
+        imgs.DrawBimpFirst := true;
         EditToolBmps := array();
         for i,v in GetToolBtns() do
         begin

designer/utslvcldesigner.tsf

@@ -1745,6 +1745,7 @@ type TDesigImageList = class(TControlImageList)
         inherited;
         Width := 24;
         Height := 24;
+        DrawBimpFirst := true;
         FIconMaps := array();
     end 
     function RegisterDitem(item);virtual;

funcext/tvclib/getdlsymaddress.tsf

@@ -2,7 +2,10 @@ function getdlsymaddress(lib,n); //
 begin
     if not(ifstring(lib) and lib and n and ifstring(n)) then return 0;
 {$ifdef linux}
-    Return dlsym(dlopen(lib,0x101) ,n);
+    pso := dlopen(lib,0x101);
+    //if pso then 
+    Return dlsym(pso ,n);
+    return 0;
 {$endif}
     Return GetProcAddress(LoadLibraryA(lib),n);    
 end 

funcext/tvclib/parserch.tsf

@@ -7,6 +7,11 @@ interface
 function pcstruct(s,f);
 function parserctokens(str);
 function chtotslclass();
+function dealcppcomment(strs);
+function csstotslarray(csstr,tname);
+function csstotslarray2(csstr,iv);
+function csstotslarray3(ret,iv);
+function cstructtotslclass(data,name,fs);
 (*
 //str := data();
 //echo tostn(str22array(str)[:,3]);
@@ -31,6 +36,7 @@ function chtotslclass();
 begin
     parsergdifunction(parserctokens(getgdihdata()));
 end
+
 function pcstruct(s,f);
 begin
     {**
@@ -48,6 +54,279 @@ begin
     **}
     return parsercstruct(parserctokens(f?lowercase(s):s));
 end
+function addtable(d,n);
+begin
+    tbs := "";
+    for i := 1 to n do tbs += "\t";
+    r := "";
+    for i,v in str2array(d,"\r\n") do if v then r += tbs+v+"\r\n";
+    return r;
+end
+function cstructtotslclass(data,name,fz);
+begin
+    {**
+    @explan(说明)将数组结构转换为对象 %%
+    **}
+    s := format("type %s = class(tslcstructureobj)\r\n",name);
+    s += "uses cstructurelib;\r\n";
+    s += "private\r\n\tstatic SSTRUCT;\r\n";
+    fs := "";
+    fp := "";
+    sf := "";
+    gsf := "";
+    intf := format("\tclass function getstruct()\r\n\tbegin\r\n\t\tif not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(\r\n%s\r\n\t\treturn SSTRUCT;\r\n\tend\r\n",addtable(tostn(data)+");",3));
+    if fz then cf2 := "public\r\nclass function memsize();\r\nbegin\r\n\tif not SSTRUCT then getstruct();\r\n\tif SSTRUCT then \r\n\tbegin\r\n\t\tldata := length(SSTRUCT)-1;\r\n\t\treturn SSTRUCT[ldata,3]+SSTRUCT[ldata,4]-SSTRUCT[0,3];\r\n\tend \r\n\treturn 0;\r\nend";
+    else cf2 := "";
+    cf := "\tpublic\r\n\tfunction create(ptr)\r\n\tbegin\r\n\t\tinherited create(getstruct(),ptr); \r\n\tend\r\n";
+    for i,v in data do
+    begin
+        v0 := v[0];
+        //fs += "\tF"+ v[0]+";\r\n";
+        fp += format('\tproperty %s index "%s" read _getvalue_ write _setvalue_;\r\n',v0,v0);
+        {sf += format("\tfunction Set%s(v)\r\n\tbegin\r\n",v0);
+        sf += format("\t\t_setvalue_('%s',v);\r\n",v0,v0,v0);
+        sf +="\tend\r\n";
+        gsf += format("\tfunction Get%s()\r\n\tbegin\r\n",v0);
+        gsf += format("\t\treturn _getvalue_('%s');\r\n",v0);
+        gsf +="\tend\r\n";}
+    end
+    s += gsf;
+    s += intf;
+    s += sf;
+    s += addtable(cf2,1);
+    s += cf;
+    s += fp;
+    s += "end";
+    return s;
+end
+//**********c结构体转换到tsl对象*********************************
+function csstotslarray3(ret,iv);
+begin
+    {**
+    @explan(说明)对c结构定义,初始值 %%
+    @param(ret)(array) 结构定义 %%
+    @param(iv)(array) 初始值 %%
+    @return(array) 结构定义
+    **}
+    r := array();
+    iv := array();
+    for i,v in ret do
+    begin
+        n := ret[i,0];
+        r[i]["n"]:= n;
+        r[i]["t"]:= ret[i,1];
+        iv[n]:= ret[i,2];
+    end
+    return r;
+end
+function csstotslarray2(csstr1,iv);
+begin
+    {**
+    @explan(说明)将c的结构体字符串形式转换为tsl数组 %%
+    @param(csstr1)(string) c结构体字符串 %%
+    @param(iv)(array) 初始值 %%
+    @return(array) 结构定义
+    **}
+    (**
+    @example(转换cstruct结构到tslarray-2)
+    s := "
+    typedef struct _SYSTEMTIME {
+    WORD wYear;
+    WORD wMonth;
+    WORD wDayOfWeek;
+    WORD wDay;
+    WORD wHour;
+    WORD wMinute;
+    WORD wSecond;
+    WORD wMilliseconds;
+    } SYSTEMTIME, *PSYSTEMTIME;
+    ";
+    return csstotslarray2(s);
+    **)
+    ret := csstotslarray(csstr1);
+    return csstotslarray3(ret,iv);
+end
+function csstotslarray(csstr1,tname);
+begin
+    {**
+    @explan(说明)将c的结构体字符串形式转换为tsl数组 %%
+    @param(csstr1)(string) c结构体字符串 %%
+    @param(tname)(string) 名称,返回值 %%
+    @return(array) 结构定义%%	
+    **}
+    (**
+    @example(转换cstruct结构到tslarray-1)
+    s := "
+    typedef struct tagWINDOWPOS {
+    HWND hwnd;
+    HWND hwndInsertAfter;
+    int  x;
+    int  y;
+    int  cx;
+    int  cy;
+    UINT flags;
+    } WINDOWPOS, *LPWINDOWPOS, *PWINDOWPOS;
+
+    ";
+    return csstotslarray(s);
+    **)
+    typecp := array("int":"int",
+        "float":"float",
+        "uint":"int",
+        "lpstr":"char*",
+        "char":"char",
+        "char*":"char*",
+        "dword":"int",
+        "long":"int",
+        "byte":"byte",
+        "short":"short",
+        "word":"short", //byte[2]
+        "rect":"int[4]",
+        "size":"int[2]",
+        "point":"int[2]",
+        "double":"double",
+        "lpcstr":"char*",
+        "bool":"int",
+        "colorref":"int",
+        "nmhdr":"nmhdr",
+        "guid":"guid",
+        "cef_string_t":"cef_string_t"
+    );
+    //类型对应初始值表
+    typecv := array(
+        "float":0,
+        "int":0,
+        "char*":100,
+        "short":0,
+        "byte":0,
+        "int[4]":array(0,0,0,0),
+        "int[2]":array(0,0),
+        "byte[2]":array(0,0),
+        "double":0,
+        "intptr":0,
+        "nmhdr":array(
+            ("hwndfrom","intptr",0),
+            ("idfrom","intptr",0),
+            ("code","int",0)),
+        "guid":(
+            ("data1","int",0),
+            ("data2","short",0),
+            ("data3","short",0),
+            ("data4","char[8]","")
+        )
+    );
+    //返回值
+    r := pcstruct(csstr1,1);
+    tslarray := array();
+    j := 0;
+    if ifarray(r)then tname := r["tname"];
+    for i,v in r["field"] do
+    begin
+        tps := v["t"];
+        tp := tps[length(tps)-1];
+        if v["p"]then
+        begin
+            if tp="char" and v["p"]=1 then tp := "char*";
+        end
+        ctyp := typecp[tp]?: "intptr"; //设置默认类型为指针
+        len := v["l"];
+        if len then ctyp := ctyp+format("[%s]",len); //设置数组初始值
+        tslarray[j++]:= array(v["n"],typetouser(ctyp),typecv[ctyp]?: 0); //构造数据
+    end
+    return tslarray;
+    (*
+    csstr := dealcppcomment(csstr1);
+    s := pos("{",csstr)+1;
+    e := pos("}",csstr);
+    //删除注释
+    str := copy(lowercase(csstr),s,e-s); //获取大括号之间的数据
+    str :=replacestr(str,"\r"," "); //替换掉换行
+    str :=replacestr(str,"\n"," "); //替换掉换行
+    str :=replacestr(str,"\t"," "); //替换掉分隔符
+    strs := str2array(str,";"); //按照;分割行
+    //类型对照表
+    tslarray := array();
+    j := 0;
+    //正则表达式表
+    //ctrl := "\\w+[*]?";
+    for i ,v in strs do
+    begin
+    parserctypestr(v,tp,len,name);
+    if not(name and tp) then continue;
+    ctyp := typecp[tp]?:"intptr"; //设置默认类型为指针
+    if len then ctyp := ctyp + format("[%d]",len); //设置数组初始值
+    tslarray[j++] := array(name,ctyp,typecv[ctyp]?:0); //构造数据
+    end 
+
+		
+    return tslarray; *)
+end
+{
+function writeloglen(len);
+begin
+lf := "d:/ts/malocsize.txt";
+if FileExists("",lf) then 
+begin
+pos1 := FileSize('',lf);
+end 
+else 
+begin
+pos1 := 0;
+end 
+a := format("分配空间大小%d",len);
+writefile(rwraw(),'',lf,pos1,length(a),a);
+end }
+function typetouser(tp);
+begin
+    if tp in array("nmhdr","guid")then
+    begin
+        return "user";
+    end
+    return tp;
+end
+//*************删除c注释*****************
+function dealcppcomment(strs)
+begin
+    {**
+    @explan(说明)删除c语言注释 %%
+    @param(strs)(string) c结构体字符串 %%
+    @return(string) 
+    **}
+    rets := "";
+    len := length(strs);
+    i := 1;
+    while i<len do
+    begin
+        ps := strs[i:i+1];
+        if ps="//" then
+        begin
+            i += 2;
+            while(true) do
+            begin
+                if strs[i]="\n" then
+                begin
+                    break;
+                end
+                i++;
+            end
+        end else
+        if(ps="/*")then
+        begin
+            i += 2;
+            while true do
+            begin
+                if strs[i:i+1]="*/" then
+                begin
+                    i += 2;
+                    break;
+                end
+                i++;
+            end
+        end
+        if i<len then rets += strs[i++];
+    end
+    return rets;
+end
 function parsercstruct(tokens,indx);
 begin
     {**

funcext/tvclib/tgdiplusflat.tsf

@@ -102,13 +102,12 @@ type TGdiplusflat=class()
         
     end 
     type TTempFile = class
+        static fobj_count;
         function Create();
         begin
+            fobj_count++;
             bp := "/tmp/tinysoft/tslvcl/";
-            
-            if not _mtool then _mtool := new aefclassobj_();
-            Fptr := _mtool.tmalloc(8);
-            FPath := bp+inttostr(systhreadid())+"_"+inttostr(Fptr);
+            FPath := bp+inttostr(systhreadid())+"_"+tostn(fobj_count);
         end 
         function GetData(buf,f);
         begin
@@ -130,13 +129,10 @@ type TGdiplusflat=class()
         function Destroy();
         begin
             filedelete("",FPath);
-            _mtool.tfree(Fptr);
         end 
         property path read FPath ;
         private
         FPath;
-        Fptr;
-        static _mtool;
     end 
     class procedure cairo_pattern_destroy(p:pointer);
     begin
@@ -394,6 +390,31 @@ type TGdiplusflat=class()
     end 
 {$else}
  //stream ´¦Àí
+     type inukownvtb = class(tslcstructureobj)
+         uses cstructurelib;
+        function create(ptr);
+        begin
+            p :=  get_mem_mgr().readptr(ptr);
+            struct := MemoryAlignmentCalculate(get_vtb_struct());  
+            inherited create(struct,p);  
+        end
+        function Release(s); 
+        begin
+            ptr := _getvalue_("Release");       
+            _f_ := function (s:pointer):integer;stdcall; external ptr;
+            r :=  ##_f_(s);
+            return r;
+        end 
+        protected 
+        function get_vtb_struct();virtual;
+        begin
+            return array(
+                    ("QueryInterface","intptr",0),
+                    ("AddRef","intptr",0),
+                    ("Release","intptr",0)
+                    );
+        end 
+    end 
     class function imagetostring(h,vp,conf); 
     begin
         CreateStreamOnHGlobal(0,true,st);
@@ -432,7 +453,10 @@ type TGdiplusflat=class()
 	class function memcpy2(var dst:string;src:pointer;size_t:integer):pointer;cdecl;external "msvcrt.dll"  name "memcpy";
 	class function tuicloseistream(sm:pointer);
 	begin
+	    o := new inukownvtb(sm);
+	    return o.release(sm);
 	    	r := tslvclcloseistream(sm);
+	    	//echo "\r\n close stream:",sm,"  ",r;
 		    return r;
 	end 
 	class function GlobalAlloc(uFlags :integer;dwBytes:integer):pointer;stdcall;external "Kernel32.dll"  name "GlobalAlloc";

funcext/tvclib/ugtkinterface.tsf

@@ -747,6 +747,25 @@ type tsgtkapi = class(tgtkapis)
         cairo_rectangle(hdc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1]);
         cairo_clip(hdc); 
     end 
+    function cairo_clip_rec(hdc,rc);
+    begin
+        cairo_set_line_width(hdc,0);
+        cairo_rectangle(hdc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1]);
+        cairo_clip_preserve(hdc); 
+        cairo_stroke(hdc);
+    end 
+    function cairo_clear_clip_ploy(hdc,ps);
+    begin
+        cairo_reset_clip(hdc);
+        for i,v in ps do 
+        begin 
+            if i=0 then cairo_move_to(hdc,v[0],v[1]);
+            else cairo_line_to(hdc,v[0],v[1]);
+        end 
+        cairo_line_to(hdc,ps[0,0],ps[0,1]);        
+        cairo_clip(hdc); 
+    end
+    
     function SelectObject(hdc :pointer;gdiobj:pointer);
     begin
         //
@@ -786,14 +805,24 @@ type tsgtkapi = class(tgtkapis)
                 y := gtk_object_get_data(dc,"viewport.y");
                 r := gtk_object_get_data(hdc,"rgn");
                 gtk_object_set_data(hdc,"rgn",gdiobj);
-                rc := (new TCRect(gdiobj))._getdata_();
-                rc[0]+=x;
-                rc[2]+=x;
-                rc[1]+=y;
-                rc[3]+=y;
-                gtk_object_set_data(hdc,"rgn-rec",rc);                
-                cairo_clear_clip(hdc,rc);
-                
+                if obj[2]="poly" then 
+                begin
+                    ps1 := (new t_points(gdiobj)).get_points(); 
+                    ps := array(); 
+                    for i,v in ps1 do 
+                    begin
+                        ps[i] := array(v[0]+x,v[1]+y);
+                    end 
+                    cairo_clear_clip_ploy(hdc,ps); 
+                end else 
+                begin  
+                    rc := (new TCRect(gdiobj))._getdata_();
+                    rc[0]+=x;
+                    rc[2]+=x;
+                    rc[1]+=y;
+                    rc[3]+=y;
+                    cairo_clear_clip(hdc,rc);
+                end
             end 
         end ;
         if r then 
@@ -1059,17 +1088,11 @@ type tsgtkapi = class(tgtkapis)
         begin
             sy := rec[3]-3-ht;
         end  
-        rgnrec := gtk_object_get_data(hdc,"rgn-rec");
-        if rgnrec then 
-        begin 
-            x := gtk_object_get_data(hdc,"viewport.x");
-            y := gtk_object_get_data(hdc,"viewport.y"); 
-            reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
-            if not intersectrect(rgnrec,reci,reco) then return 0; 
-            cairo_clear_clip(hdc,reco);           
-        end        
+        cairo_save(hdc);
+        reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
+        cairo_clip_rec(hdc,reci);
         r :=  TextOutexA(hdc,sx,sy,txt,slen); 
-        if rgnrec then cairo_clear_clip(hdc,rgnrec); 
+        cairo_restore(hdc);
         return r;
     end 
     Function SetTextColor(hdc :pointer;col:integer):integer;
@@ -1194,11 +1217,22 @@ type tsgtkapi = class(tgtkapis)
         if not(gdiobj) then 
         begin
             gtk_object_set_data(hdc,"rgn",nil); 
-            gtk_object_set_data(hdc,"rgn-rec",nil); 
             cairo_reset_clip(hdc);  
         end 
         return r;
     end 
+    function CreatePolygonRgn(ps:array of integer;len:integer;md:integer):pointer;
+    begin
+        global gtk_gdi_object_globals; 
+        if ifarray(ps) and mrows(ps)>2 and mcols(ps)=2 then 
+        begin 
+            p := new t_points();
+            p.set_points(ps);
+            ptr := p._getptr_();
+            gtk_gdi_object_globals[inttostr(ptr)] := array(p,"rgn","poly");
+            return ptr;
+        end     
+    end 
     function CreateRectRgn(nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer):pointer;
     begin
         global gtk_gdi_object_globals; 
@@ -1208,7 +1242,7 @@ type tsgtkapi = class(tgtkapis)
         p.right := nRightRect;
         p.bottom := nBottomRect;
         ptr := p._getptr_();
-        gtk_gdi_object_globals[inttostr(ptr)] := array(p,"rgn");
+        gtk_gdi_object_globals[inttostr(ptr)] := array(p,"rgn","rect");
         return ptr;
     end 
     function CombineRgn(hrgnDest:pointer;hrgnSrc1:pointer;hrgnSrc2:pointer; fnCombineMode:integer):integer;
@@ -2769,7 +2803,7 @@ type tsgtkapi = class(tgtkapis)
     end 
     function ILCreateFromPathA(pszPath:string):pointer;
     begin
-        mt :=  static new aefclassobj_();
+        mt :=  unit(cstructurelib).get_mem_mgr();
         len := length(pszPath)+1;
         bts := zeros(n);
         for i:= 1 to len-1 do bts[i-1] :=ord(pszPath[i]); 
@@ -2779,7 +2813,7 @@ type tsgtkapi = class(tgtkapis)
     end 
     procedure ILFree(pidl:pointer);
     begin		    
-        mt :=  static new aefclassobj_();
+        mt :=  unit(cstructurelib).get_mem_mgr();
         mt.tfree(pidl);        
     end 
     		//caret 插入符号 处理
@@ -3011,6 +3045,41 @@ type TGtkList = class( _gslist) //gtk
         inherited;
     end 
 end 
+type t_points=class(tslcstructureobj)
+    private
+    static fpoints;
+    static SSTRUCT;
+    function getstruct()
+    begin
+        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
+                (0,"int",0)));
+        return SSTRUCT;
+    end
+    public
+    function create(ptr)
+    begin
+        if not ifarray(fpoints) then fpoints := array();
+        inherited create(getstruct(),ptr);
+    end
+    function set_points(d);
+    begin
+        p := _getptr_();
+        if p then 
+        begin 
+            //_setvalue_(0,length(d));
+            fpoints[inttostr(p)] := d;
+        end         
+    end 
+    function get_points();
+    begin
+        p := _getptr_();
+        if p then 
+        begin 
+            return fpoints[inttostr(p)];
+        end  
+    end 
+
+end 
 type ttmstruct=class(tslcstructureobj)
     {**
     @explan(说明)矩形区域内存分配 %%
@@ -4128,7 +4197,7 @@ type tgtkapis = class() //gtk
         r :=  ##_f_(d);  
         rr := r;
         ret := array();
-        _tool := static new aefclassobj_();
+        _tool := unit(cstructurelib).get_mem_mgr();
         while true do 
         begin             
             p1 := _tool.readptr(r);  
@@ -4451,9 +4520,13 @@ type tgtkapis = class() //gtk
     begin
         fm := pango_cairo_font_map_get_default();
         pango_font_map_list_families(fm,ls,lsn);
-        mt := new aefclassobj_();
+        mt := unit(cstructurelib).get_mem_mgr();
         r := array();
-        psize := static  getctypesize()["intptr"];
+        {$ifdef win32}
+            psize := 4;
+        {$else}
+            psize := 8;
+        {$endif }
         for i:= 0 to lsn -1 do 
         begin
             pi := mt.readptr(ls+psize*i);
@@ -4614,7 +4687,7 @@ type tgtkapis = class() //gtk
         _f_ := static procedure(c:pointer);cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(c);
     end
-    procedure cairo_clip_preserve(c:pointer);
+    procedure cairo_clip_preserve(c:pointer); //µþ¼Ó²Ã¼ô
     begin
         _f_ := static procedure(c:pointer);cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(c);

funcext/tvclib/utslvclgdi.tsf

@@ -822,6 +822,56 @@ type TRGNRoundRect=class(TRGNELLIP)
     property EllipseWidth:integer read FEllipseWidth write SetEllipseWidth;
     property EllipseHeight:integer read FEllipseHeight write SetEllipseHeight;
 end
+type TRGNPOLY=class(TRGN) //多边形
+    {**
+    @explan(说明)多边形区域%%	
+    **}
+    private
+    FPoints;
+    FImode;
+    function points_ok(d);
+    begin
+        if ifarray(d) and mrows(d)>2 and mcols(d)=2 then 
+        begin 
+            for i,v in d do 
+            begin 
+                if not(ifnumber(v[0]) and ifnumber(v[1])) then return false;
+            end 
+            return true;
+        end 
+    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 points_ok(v) and  v <> FPoints then
+        begin
+            FPoints := v;
+            DestroyHandle();
+        end
+    end
+    public
+    function create(); //点 和填充模式
+    begin
+        inherited;
+        FPoints := array();
+        FImode := ALTERNATE;
+    end
+    function CreateRgn();override;
+    begin
+        if not FPoints then return 0;
+        len := length(FPoints);
+        return _wapi.CreatePolygonRgn(FPoints,len,FImode);
+    end
+    property Points read FPoints write SetPoints;
+    property Imode read FImode write SetImode;
+end
 
 
 type tcustomimage=class(TSLUIBASE)
@@ -837,6 +887,8 @@ type tcustomimage=class(TSLUIBASE)
         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;
+        return   FImageTypes[t]; //新代码
+        
         vp := FImageTypes[t];
         if vp then return vp;
         dt := MemoryAlignmentCalculate(array((0,"byte[20]",array())),1,nil,nil);
@@ -874,7 +926,19 @@ type tcustomimage=class(TSLUIBASE)
         inherited;
         if not ifarray(FImageTypes)then
         begin
-            //return ;
+            {$ifdef linux}
+            FImageTypes := array();
+            for i,v in array("png","jpeg","bmp","gif","tiff") do 
+            begin 
+                dt := MemoryAlignmentCalculate(array((0,"byte[20]",array())),1,nil,nil);
+                vp := new tslcstructureobj(dt,nil);
+                WriteStringToPtr(vp._getptr_(),"image/"+v);                
+                FImageTypes[v] := vp;                
+            end  
+            return ;           
+            {$endif}
+            FImageTypes := GetEncoderClsid();
+            return ;            
             FImageTypes := array();
             for i,v in array("png","jpeg","bmp","gif","tiff") do
             begin
@@ -2827,6 +2891,7 @@ type TcustomCanvas = class(TSLUIBASE)
             begin
                 FCounter.DeCrease();
                 _wapi.RestoreDC(FHandle,-1);
+                FState := 1+2+4+8+16+32;
             end
         end
     end
@@ -2862,6 +2927,7 @@ type TControlCanvs=class(TcustomCanvas)
     FClipRect;
 end
 implementation
+
 	/////////////////////////////////
 type TResourcescache=class
     {**
@@ -2987,6 +3053,11 @@ type tshape = class()
     begin
         return self(true);
     end 
+    function requiregdi();
+    begin
+        if fcanvas then FCanvas.requiregdi();
+        return self(true);    
+    end 
     protected 
     [weakref]fcanvas;
 end 
@@ -3374,6 +3445,68 @@ begin
         "ProfileNotFound");
     return vs[v];
 end
+function GdipGetImageEncodersSize(var numencoders:integer;var size:integer):integer;stdcall ;external "Gdiplus.dll" name "GdipGetImageEncodersSize";
+Function GdipGetImageEncoders(numEncoders:integer;size:integer;encoders:pointer):pointer;stdcall;external "gdiplus.dll" name "GdipGetImageEncoders";
+function GetEncoderClsid();
+begin
+    num := 0;          // number of image encoders
+    size := 0;         // size of the image encoder array in bytes
+    GdipGetImageEncodersSize(num,size);
+    if size=0 then return -1;
+    mg := get_mem_mgr();
+    ptr := mg.tmalloc(size);
+    strc := get_imagecodec_(num);
+    o := static new tslcstructureobj(MemoryAlignmentCalculate(strc),ptr);
+    GdipGetImageEncoders(num, size, ptr);
+    r := array();
+    for i := 0 to num-1 do 
+    begin 
+        oa := o._getvalue_(i);
+        mt := oa._getvalue_("MimeType");
+        s := ReadStringFromPtr(mt,2*widestr_ptr_len(mt));
+        if mt then 
+        begin
+            si := "";
+            for j:= 1 to length(s) step 2 do 
+            begin 
+                si+=s[j];
+            end         
+            r[si[7:]] := oa._getvalue_("Clsid");
+        end 
+    end 
+    return r;   
+end 
+function get_imagecodec_(n);
+begin
+    r := array();
+    g_s := array(
+                ("data1","int",0xf59a8177),
+                ("data2","short",0x2a0),
+                ("data3","short",0x4019),
+                ("data4","byte[8]",array(0xa3, 0x93, 0xaf, 0x7, 0x9f, 0x9a, 0xb3, 0x62)),
+                );
+    idx := 0;
+    r[idx++] := array("Clsid","user",g_s);
+    r[idx++] := array("FormatID","user",g_s);    
+    r[idx++] := array("CodecName","pointer",0);
+    r[idx++] := array("DllName","pointer",0);
+    r[idx++] := array("FormatDescription","pointer",0);
+    r[idx++] := array("FilenameExtension","pointer",0);
+    r[idx++] := array("MimeType","pointer",0);
+    r[idx++] := array("Flags","int",0);
+    r[idx++] := array("Version","int",0);
+    r[idx++] := array("SigCount","int",0);
+    r[idx++] := array("SigSize","int",0);
+    r[idx++] := array("SigPattern","pointer",0);
+    r[idx++] := array("SigMask","pointer",0);
+    rt := array();
+    if n>0 then 
+    begin
+        for i := 0 to n-1 do 
+        rt[i] := array(i,"user",r);
+    end 
+    return rt;
+end 
 initialization
 sinitgidplus();
 class(tcustomimage).sinit();
@@ -3382,58 +3515,3 @@ class(tUIglobalData).uisetdata("G_T_ICON_",class(TcustomIcon));
 finalization
 
 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
-*)

funcext/tvclib/uwindowsinterface.tsf

@@ -401,8 +401,8 @@ type twindowsapi = class()
     function GetCaretBlinkTime():integer;stdcall;external "User32.dll" name "GetCaretBlinkTime";
     function GetCaretPos(lp:array of integer):integer;stdcall;external "User32.dll" name "GetCaretPos";
     
-    function memcpy(dst:pointer;src:string;size_t:integer):pointer;cdecl;external "msvcrt.dll"  name "memcpy";
-    function memcpy2(var dst:string;src:pointer;size_t:integer):pointer;cdecl;external "msvcrt.dll"  name "memcpy";
+    function memcpy(dst:pointer;src:string;size_t:pointer):pointer;cdecl;external "msvcrt.dll"  name "memcpy";
+    function memcpy2(var dst:string;src:pointer;size_t:pointer):pointer;cdecl;external "msvcrt.dll"  name "memcpy";
     function fopen(filename:string; mode:string):pointer;cdecl;external "msvcrt.dll"  name "fopen";
     function exec_command_line(cmd:string); //执行cmd 并获得打印结果
     begin