界面库

修正内存管理的问题

designer/teditorform.tsf

@@ -1379,7 +1379,6 @@ type tdirlistbox = class(TListBox)
         r := inherited;
         return to_ansi_str(r); //"["$ i $"]" $ 
     end 
-
 end 
 type tsearchdir = class(TCustomControl)
     uses tslvcl;

funcext/tvclib/cstructurelib.tsf

@@ -1355,9 +1355,9 @@ type t_mem_mgr =  class()
         if _tool then 
         begin 
             if fpointersize=8 then return _tool.readptr(p);
-            d := _tool.readuints(p,2);
+            //d := _tool.readuints(p,2);
-            r := (int64(d[1]) shl 32) .| (int64(d[0]) .& 0xffffffffL);         
+            //r := (int64(d[1]) shl 32) .| (int64(d[0]) .& 0xffffffffL);         
-            return r; 
+            //return r; 
         end   
         r := 0L;
         memcpy_ptr_int64(r,p);
@@ -1381,7 +1381,7 @@ type t_mem_mgr =  class()
             return  _tool.readstr(p);
         r:="";
         len := strlen(p);
-        setlength(r,strlen(p));
+        setlength(r,len);
         memcpy1(r,p,len);
         return r;
     end 
@@ -1405,8 +1405,13 @@ type t_mem_mgr =  class()
         **}
         if _tool then 
             return  _tool.readlong(p);
-        r := 0;
+        {$ifdef linux}
-        memcpy_ptr_int(r,p,4);
+            r := 0L;
+            memcpy_ptr_int64(r,p);
+        {$else}
+            r := 0;
+            memcpy_ptr_int(r,p,4);
+        {$endif}        
         return r;
     end
     function readulong(p);
@@ -1417,8 +1422,14 @@ type t_mem_mgr =  class()
         **}
         if _tool then 
             return  _tool.readulong(p);
-        r := 0;
+        {$ifdef linux}
-        memcpy_ptr_int(r,p,4);
+            r := 0L;
+            ct := 8;
+        {$else}
+            r := 0;
+            ct := 4;
+        {$endif}        
+        memcpy_ptr_int(r,p,ct);
         return r;
     end
     function readints(p,sz);
@@ -1432,8 +1443,6 @@ type t_mem_mgr =  class()
             return  _tool.readints(p,sz);
         r := ones(sz);
         memcpy_ptr_ints(r,p,sz*4);
-        //echo tostn(r1);
-        //echo tostn(r);
         return r;
     end
     function readuints(p,sz);
@@ -1457,12 +1466,6 @@ type t_mem_mgr =  class()
         if _tool then 
         begin 
             if fpointersize=8 then return readintptrs(p,sz);
-            r := array();
-            for i:= 0 to sz-1 do 
-            begin
-                r[i] := readint64(p+i*fpointersize);
-            end 
-            return r;
         end
         r := zeros(sz);
         memcpy_ptr_int64s(r,p,sz*8);
@@ -1605,15 +1608,15 @@ type t_mem_mgr =  class()
         if _tool then 
         begin
             if fpointersize=8 then return _tool.writeptr(p,v);       
-            d := array();
+            {d := array();
             d[0] := 0xff .& v;
             for i:= 1 to 7 do 
             begin 
                 d[i] := (v shr (i*8)) .& 0xff;
             end 
-            return _tool.writebytes(p,8,d);
+            return _tool.writebytes(p,8,d);}
         end 
-        memcpy_int64_ptr(p,v,8);
+        memcpy_int64_ptr(p,v);
         return 1;             
     end 
     function writedouble(p,v);
@@ -1663,7 +1666,11 @@ type t_mem_mgr =  class()
         **}
         if _tool then 
             return  _tool.writelong(p,v); 
-        return writeint(p,v);        
+        {$ifdef linux}
+            return writeint64(p,v);
+        {$else}
+            return writeint(p,v);   
+        {$endif}     
     end
     function writeulong(p,v);
     begin
@@ -1705,14 +1712,14 @@ type t_mem_mgr =  class()
         if _tool then 
         begin 
             if fpointersize=8 then return writeintptrs(p,sz,v);
-            len := min(sz,length(v));
+            {len := min(sz,length(v));
             for i:= 0 to len-1 do 
             begin 
                 writeint64(p+i*fpointersize,v[i]);
             end
-            return 1; 
+            return 1;} 
         end         
-        memcpy_int64_ptrs(p,sz,v*8);
+        memcpy_int64_ptrs(p,v,min(sz,length(v))*8);
         return 1;   
     end
     function writedoubles(p,sz,v);
@@ -1856,14 +1863,12 @@ type t_mem_mgr =  class()
     begin
         _f_ := static function(var dst:integer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
         r :=  ##_f_(dst,src,size_t);
-        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
         return r;
     end 
     function memcpy_ptr_ints(var dst:array of integer;src:pointer;size_t:pointer):pointer;
     begin
         _f_ := static function(var dst:array of integer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
         r :=  ##_f_(dst,src,size_t);
-        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
         return r;
     end 
     function memcpy_int_ptr(dst:pointer;var src:integer;size_t:pointer):pointer;
@@ -1882,14 +1887,12 @@ type t_mem_mgr =  class()
     begin
         _f_ := static function(dst:pointer;src:array of short;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
         r :=  ##_f_(dst,src,size_t);
-        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
         return r;
     end 
     function memcpy_ptr_shorts(var dst:array of short;src:pointer;size_t:pointer):pointer;
     begin
         _f_ := static function(var dst:array of short;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
         r :=  ##_f_(dst,src,size_t);
-        //echo "\r\n read int out:",dst,"  ",r,"  ",src,"  ",size_t,"  ",isnan(dst);
         return r;
     end 
     //////////////////////////////////////////////////////////////////
@@ -1967,17 +1970,17 @@ type t_mem_mgr =  class()
     function memcpy_ptr_int64(var dst:int64;src:pointer;size_t:pointer):pointer;
     begin
         _f_ := static function(var dst:int64;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
-        return ##_f_(dst,src,64);
+        return ##_f_(dst,src,8);
     end 
     function memcpy_ptr_int64s(var dst:array of int64;src:pointer;size_t:pointer):pointer;
     begin
         _f_ := static function(var dst:array of int64;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
-        return ##_f_(dst,src,64);
+        return ##_f_(dst,src,8);
     end 
     function memcpy_int64_ptr(dst:pointer;var src:int64;size_t:pointer):pointer;
     begin
         _f_ := static function(dst:pointer;var src:int64;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy");
-        return ##_f_(dst,src,64);
+        return ##_f_(dst,src,8);
     end
     function memcpy_int64_ptrs(dst:pointer;src:array of int64;size_t:pointer):pointer;
     begin
@@ -2349,6 +2352,10 @@ begin
     psize := 4;
 {$else}
     psize := 8;
+{$endif}
+    longsize := 4;
+{$ifdef linux}
+    longsize := 8;
 {$endif}
     r := array();
     r["int"] := 4;
@@ -2361,9 +2368,9 @@ begin
     r["double"] := 8;
     r["short"] := 2;
     r["ushort"] := 2;
-    r["long"] := 4;
+    r["long"] := longsize;
-    r["ulong"] := 4;
+    r["ulong"] := longsize;
-    r["LONG"] := 4;
+    r["LONG"] := longsize;
     r["bool"] := 4;
     r["byte"] := 1;
     r["BYTE"] := 1;

funcext/tvclib/ugtkinterface.tsf

@@ -2484,6 +2484,7 @@ type tsgtkapi = class(tgtkapis)
         const CF_TEXT=0x1;
         const CF_BITMAP=0x2;
         c := g_clipbaord_ptr;
+        bf := gtk_text_buffer_new(0);               
         if not( c>0 or c<0) then return 0;
         case fmt of
             CF_TEXT:
@@ -2780,19 +2781,22 @@ type tsgtkapi = class(tgtkapis)
     begin
         obj  := new ttagCHOOSECOLORA(LOGFONTA); 
         cdlg := gtk_color_selection_dialog_new("color select dialog"); 
-         btnptr := tsl_gtk_color_selection_property(cdlg); //ťńľĂÎťÖĂ
+        ///////////////////////////////////////////////////////////////////////          
-        //cpbtns := tslcstructure(array((0,"intptr",0)),nil,nil,btnptr);
+        //btnptr := tsl_gtk_color_selection_property(cdlg); //»ñµÃλÖÃ
-        cpbtns := new Tintptr(btnptr);
+        //cpbtns := new Tintptr(btnptr);
-        cbtnobj := cpbtns._getvalue_(0);
+        //cbtnobj := cpbtns._getvalue_(0);
-        color := new _GdkColor();
+        cbtnobj := gtk_color_selection_dialog_get_color_selection(cdlg);
+        /////////////////////////////////////////////////////////////////
+        color := static new _Gdkrgba();
         rc := obj.rgbresult ;
-        rcs := array(getrvalue(rc),getgvalue(rc),getbvalue(rc));
+        color.set_c(rc);   
-        color.setrgb((_shl( rcs[0],8)),(_shl(rcs[1],8)),(_shl( rcs[2],8)));
+        //gtk_color_selection_set_has_opacity_control(cbtnobj,true);   
-        gtk_color_selection_set_current_color(cbtnobj,color._getptr_());
+        gtk_color_selection_set_has_palette(cbtnobj,true);   
+        gtk_color_selection_set_current_rgba(cbtnobj,color._getptr_());
         r := gtk_dialog_run(cdlg);
         //rt := Gtk_dlg_get_response_name_by_id(r);
-        gtk_color_selection_get_current_color(cbtnobj,color._getptr_());
+        gtk_color_selection_get_current_rgba(cbtnobj,color._getptr_());
-        obj.rgbresult := rgb( _shr(color.r,8),_shr(color.g,8),_shr(color.b,8));
+        obj.rgbresult := color.get_c();
         gtk_widget_destroy(cdlg);
         return r=-5;
     end 
@@ -3198,14 +3202,6 @@ type tmenuitemobject = class(tgtk_ctl_object) //gtk
     end 
 end 
 type tgtkapis = class() //gtk对象api接口
-    function gtk_rgb_color_rgb(c,r,g,b);
-    begin
-        if not ifnumber(c) then return 0;
-        r := getrvalue(c)/0xff;
-        g := getgvalue(c)/0xff;
-        b := getbvalue(c)/0xff ;  
-        return true; 
-    end 
     function gtk_object_set_data(h,n,v); //保存数据
     begin
         if not(h>0 or h<0) then return 0;
@@ -3643,6 +3639,12 @@ type tgtkapis = class() //gtk
         _f_ := static function(t:string):pointer;cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(t);
     end
+    function gtk_color_selection_dialog_get_color_selection(d:pointer):pointer;
+    begin
+        _f_ := static function(d:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(d);
+    end
+    
     function Gtk_event_get_name_by_id(id); //gdk消息名称--id对应
     begin
     	d := array(0:"GDK_DELETE",1:"GDK_DESTROY",2:"GDK_EXPOSE",3:"GDK_MOTION_NOTIFY",4:"GDK_BUTTON_PRESS",
@@ -3688,6 +3690,17 @@ type tgtkapis = class() //gtk
     //function tsl_gtk_kill(p:pointer;sig:integer):integer;cdecl;external "plugin/libTSLUIL.so";
     //function tsl_gtk_createprocessa(exe:string;  cmd : array of string;  ev : array of string;var pw:pointer):pointer;cdecl;external "plugin/libTSLUIL.so";
     //
+    procedure g_object_get_property(g:pointer;n:string;v:pointer);
+    begin
+        _f_ := static procedure(g:pointer;n:string;v:pointer); cdecl; external getfuncptrbyname(0,functionname()); ////libglib-2.0.so
+        return ##_f_(g,n,v);
+    end 
+    function g_value_get_pointer(v:pointer):pointer; 
+    begin
+        _f_ := static function(v:pointer):pointer; cdecl; external getfuncptrbyname(0,functionname()); ////libglib-2.0.so
+        return ##_f_(v);
+    end
+    
     procedure g_free(mem:pointer);
     begin
         _f_ := static procedure(mem:pointer); cdecl; external getfuncptrbyname(0,functionname()); ////libglib-2.0.so
@@ -3735,6 +3748,12 @@ type tgtkapis = class() //gtk
         _f_ := static function(clip:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(clip);
     end 
+    function gtk_clipboard_wait_is_rich_text_available(clip:pointer;tgs:pointer):integer;
+    begin
+        _f_ := static function(clip:pointer;tgs:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(clip,tgs);
+    end 
+    
     function gtk_clipboard_wait_is_image_available(clip:pointer):integer;
     begin
         _f_ := static function(clip:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
@@ -5627,11 +5646,34 @@ type tgtkapis = class() //gtk
         _f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(w,c);
     end
+    procedure gtk_color_selection_set_current_rgba(w:pointer;c:pointer);
+    begin
+        _f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(w,c);
+    end
+    procedure gtk_color_selection_get_current_rgba(w:pointer;c:pointer);
+    begin
+        _f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(w,c);
+    end    
     procedure gtk_color_selection_get_current_color(w:pointer;c:pointer);
     begin
         _f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname());
         return ##_f_(w,c);
     end
+    procedure gtk_color_selection_set_has_opacity_control(w:pointer;c:integer);
+    begin
+        _f_ := static procedure(w:pointer;c:integer);cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(w,c);
+    end
+    procedure gtk_color_selection_set_has_palette(w:pointer;c:integer);
+    begin
+        _f_ := static procedure(w:pointer;c:integer);cdecl;external getfuncptrbyname(0,functionname());
+        return ##_f_(w,c);
+    end
+    
+    
+    
     function  gdk_color_parse(cs:string;c:pointer):integer;
     begin
         _f_ := static function(cs:string;c:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
@@ -6507,7 +6549,48 @@ type _GtkTextIter=class(tslcstructureobj)
         class(tslcstructureobj).create(getstruct(),ptr);
     end
 end
-
+type _Gdkrgba=class(tslcstructureobj)
+    static classstruct;
+    class function getstruct();
+    begin
+        if not classstruct then
+        begin
+            classstruct := MemoryAlignmentCalculate(array(
+                    ("r","double",0),
+                    ("g","double",0),
+                    ("b","double",0),
+                    ("a","double",0)));
+        end
+        return classstruct;
+    end
+    function create(ptr);
+    begin
+        class(tslcstructureobj).create(getstruct(),ptr);
+    end
+    function set_c(c);
+    begin
+        if gtk_rgb_color_rgb(c,r1,g1,b1) then 
+        begin 
+            r := r1;
+            g := g1;
+            b := b1;
+        end 
+    end 
+    function get_c();
+    begin
+        if gtk_rgb_color_rgb2(_getvalue_("r"),_getvalue_("g"),_getvalue_("b"),c) then return c;    
+    end 
+    function SetRgb(red,green,blue);
+    begin
+        r := red;
+        g := green;
+        b := blue;
+    end
+    property a index "a" read _getvalue_ write _setvalue_;
+    property r index "r" read _getvalue_ write _setvalue_;
+    property g index "g" read _getvalue_ write _setvalue_;
+    property b index "b" read _getvalue_ write _setvalue_;
+end
 type _GdkColor=class(tslcstructureobj)
     static classstruct;
     class function getstruct();
@@ -6537,6 +6620,88 @@ type _GdkColor=class(tslcstructureobj)
     property g index "g" read _getvalue_ write _setvalue_;
     property b index "b" read _getvalue_ write _setvalue_;
 end
+type _GdkColor=class(tslcstructureobj)
+    static classstruct;
+    class function getstruct();
+    begin
+        if not classstruct then
+        begin
+            classstruct := MemoryAlignmentCalculate(array(
+                    ("p","int",0),
+                    ("r","short",0),
+                    ("g","short",0),
+                    ("b","short",0)));
+        end
+        return classstruct;
+    end
+    function create(ptr);
+    begin
+        class(tslcstructureobj).create(getstruct(),ptr);
+    end
+    function SetRgb(red,green,blue);
+    begin
+        r := red;
+        g := green;
+        b := blue;
+    end
+    property p index "p" read _getvalue_ write _setvalue_;
+    property r index "r" read _getvalue_ write _setvalue_;
+    property g index "g" read _getvalue_ write _setvalue_;
+    property b index "b" read _getvalue_ write _setvalue_;
+end
+type _gvaluev = class(tmemoryclass)
+    function create();
+    begin
+        inherited;
+    end 
+    function v_int();
+    begin
+        return mtool().readint(fptr);
+    end 
+    function v_int64();
+    begin
+        return mtool().readint64(fptr);
+    end
+    function v_double();
+    begin
+        return mtool().readdouble(fptr);
+    end 
+    function v_pointer();
+    begin
+        return mtool().readptr(fptr);
+    end 
+    fptr;
+end 
+type _Gvalue=class(tslcstructureobj)
+    private
+    static SSTRUCT;
+    class function getstruct()
+    begin
+        if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(("g_type","int64",0),
+                ("v1","int64",1),
+                ("v2","int64",0)));
+        return SSTRUCT;
+    end
+    public
+    function create(ptr)
+    begin
+        inherited create(getstruct(),ptr);
+        fdatas := array(new _gvaluev(),new _gvaluev());
+    end
+    function data(idx);
+    begin
+        r :=  fdatas[idx>0?1:0];
+        r.fptr := _getvalueaddr_((idx>0?"v2":"v1"));
+        return r;
+    end 
+    function destroy();override;
+    begin
+        inherited;
+    end
+    private     
+    fdatas;
+end
+/////////////////gdi///////////////////////////////////////////
 type ttgtk_pen=class(tslcstructureobj)
     private
     static SSTRUCT;
@@ -6566,7 +6731,6 @@ type ttgtk_pen=class(tslcstructureobj)
     private
     _wapi;
 end
-/////////////////gdi///////////////////////////////////////////
 type ttgtk_brush=class(tslcstructureobj)
     private
     static SSTRUCT;
@@ -9220,8 +9384,8 @@ type tGtkMessageQueue=class //
     function createidle();
     begin
         if fidleworked then return ;
-        idledata :=(new tcbytearray(4))._getptr_();
+        //idledata :=(new tcbytearray(4))._getptr_();
-        id := tsl_gtk_idle_interface(idledata);
+        //id := tsl_gtk_idle_interface(idledata);
         fidleworked := true;
     end 
     function Clean();
@@ -10026,7 +10190,22 @@ begin
     return _gtkeventcall_(a,GetGtkEventNameOrId(b),0);
 end 		
 /////////////////////////////////////////////////////////////
-
+function gtk_rgb_color_rgb(c,r,g,b);
+begin
+    if not ifnumber(c) then return 0;
+    r := getrvalue(c)/0xff;
+    g := getgvalue(c)/0xff;
+    b := getbvalue(c)/0xff ;  
+    return true; 
+end 
+function gtk_rgb_color_rgb2(r,g,b,c);
+begin
+    if ifnumber(r) and ifnumber(g) and ifnumber(b) then 
+    begin 
+        c := rgb(integer(r*0xff),integer(g*0xff),integer(b*0xff));
+        return true;
+    end 
+end 
 
 function is_wayland();
 begin

funcext/tvclib/utslvclauxiliary.tsf

@@ -70,28 +70,13 @@ type tuiglobaldata=class() //ȫ
 end
 type TCharDiscrimi=class() //字符判断
     private 
-    static CD_SMA;
+    static const CD_SMA = 97;
-    static CD_BGA;
+    static const CD_BGA = 65;
-    static CD_SMZ;
+    static const CD_SMZ = 122;
-    static CD_BGZ;
+    static const CD_BGZ = 90;
-    static CD_UDL;
+    static const CD_UDL =95;
-    static CD_NIN;
+    static const CD_NIN = 57;
-    static CD_ZER;
+    static const CD_ZER =48 ;
-    static CD_ISOK;
-    class function sinit();virtual;
-    begin
-        if not CD_ISOK then
-        begin
-            CD_ISOK := 1;
-            CD_SMA := ord("a");
-            CD_BGA := ord("A");
-            CD_SMZ := ord("z");
-            CD_BGZ := ord("Z");
-            CD_UDL := ord("_");
-            CD_NIN := ord("9");
-            CD_ZER := ord("0");
-        end
-    end
     public
     function IsLetter(cc);
     begin
@@ -149,10 +134,6 @@ type TCharDiscrimi=class() //
         end
         return 0;
     end 
-    function create();
-    begin
-        sinit();
-    end
 end
 type tidcreater=class() //id生成
     {**