界面库

修正内存管理的问题
This commit is contained in:
tslediter 2024-03-15 11:30:10 +08:00
parent 515f227bb2
commit 8e650d2a3b
4 changed files with 252 additions and 86 deletions

View File

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

View File

@ -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);
r := (int64(d[1]) shl 32) .| (int64(d[0]) .& 0xffffffffL);
return r;
//d := _tool.readuints(p,2);
//r := (int64(d[1]) shl 32) .| (int64(d[0]) .& 0xffffffffL);
//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;
memcpy_ptr_int(r,p,4);
{$ifdef linux}
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;
memcpy_ptr_int(r,p,4);
{$ifdef linux}
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["ulong"] := 4;
r["LONG"] := 4;
r["long"] := longsize;
r["ulong"] := longsize;
r["LONG"] := longsize;
r["bool"] := 4;
r["byte"] := 1;
r["BYTE"] := 1;

View File

@ -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:
@ -2705,7 +2706,7 @@ type tsgtkapi = class(tgtkapis)
begin
bts[i-1] := ord(gf[i]);
end
WriteBytesToPtr(fptr,bts);}
WriteBytesToPtr(fptr,bts);}
r := true;
end
end
@ -2778,21 +2779,24 @@ type tsgtkapi = class(tgtkapis)
end
function ChooseColorA(LOGFONTA:pointer):integer;//颜色选择
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);
cpbtns := new Tintptr(btnptr);
cbtnobj := cpbtns._getvalue_(0);
color := new _GdkColor();
obj := new ttagCHOOSECOLORA(LOGFONTA);
cdlg := gtk_color_selection_dialog_new("color select dialog");
///////////////////////////////////////////////////////////////////////
//btnptr := tsl_gtk_color_selection_property(cdlg); //»ñµÃλÖÃ
//cpbtns := new Tintptr(btnptr);
//cbtnobj := cpbtns._getvalue_(0);
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.setrgb((_shl( rcs[0],8)),(_shl(rcs[1],8)),(_shl( rcs[2],8)));
gtk_color_selection_set_current_color(cbtnobj,color._getptr_());
color.set_c(rc);
//gtk_color_selection_set_has_opacity_control(cbtnobj,true);
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_());
obj.rgbresult := rgb( _shr(color.r,8),_shr(color.g,8),_shr(color.b,8));
gtk_color_selection_get_current_rgba(cbtnobj,color._getptr_());
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_();
id := tsl_gtk_idle_interface(idledata);
//idledata :=(new tcbytearray(4))._getptr_();
//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

View File

@ -70,28 +70,13 @@ type tuiglobaldata=class() //ȫ
end
type TCharDiscrimi=class() //字符判断
private
static CD_SMA;
static CD_BGA;
static CD_SMZ;
static CD_BGZ;
static CD_UDL;
static CD_NIN;
static CD_ZER;
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
static const CD_SMA = 97;
static const CD_BGA = 65;
static const CD_SMZ = 122;
static const CD_BGZ = 90;
static const CD_UDL =95;
static const CD_NIN = 57;
static const CD_ZER =48 ;
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生成
{**