diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index a1838ab..ce0bda4 100644 --- a/designer/udesignerproject.tsf +++ b/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 diff --git a/designer/utslvcldesigner.tsf b/designer/utslvcldesigner.tsf index 0862c46..37c1cea 100644 --- a/designer/utslvcldesigner.tsf +++ b/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; diff --git a/funcext/tvclib/cstructurelib.tsf b/funcext/tvclib/cstructurelib.tsf index 0ec3d64..db240ad 100644 --- a/funcext/tvclib/cstructurelib.tsf +++ b/funcext/tvclib/cstructurelib.tsf @@ -1,87 +1,48 @@ Unit cstructurelib; +Interface {** - @explan(说明)内存对象工具 %% - @example(范例1) - - + @explan(说明)内存对象工具 %% **} - (* 概览: 天软科技 20171215 添加注释 - 20170904 修改,提供 - ctypedefine 函数(定义结构体) - tcstruct 类(定义结构体) - tcpointer 类(结构体内存管理) - - c语言内存结构相关功能库 - 1.实现c结构体和tsl的交互 - - 提供方法 - csstotslarray2(data) 将c的结构体字符串形式 转换为tsl array 结构;由于宏定义的原因需要手工修改一下,但是也提高了转换效率 - 例1: - data := " - typedef struct tagNMTBHOTITEM { - double hdr; - int idOld; - int idNew; - DWORD dwFlags; - } NMTBHOTITEM, *LPNMTBHOTITEM; - "; - r := csstotslarray2(data); - typ1 := ctypedefine("tagNMTBHOTITEM",r); - return typ1.show;//打印结构体排布情况 - - 使用范例: - c中定义: - struct ts3 { - char a[3]; - double b; - }; - struct ts2 { - char a[5]; - int b[3]; - ts3 e; - ts3* c; - }; - struct ts1 { - char a[3]; - ts2 m1; - - - }; - - + 20240308 整理代码 *) - -Interface -uses parserch; +(** + @example(范例--内存管理--1) + sa := array(("f","int",2), + ("a","char[3]","cd"), + ("b","user",(("c","char[5]","ab"), + ("d","int",5))), + ("c","user*",(("c","char[5]","ab"), + ("d","int",5), + ("e","char*","abcd"))) + + ); + data := tslarraytocstructcalc(sa); + o := new ctslctrans(data); + return echo o._size_(),"****", + o._getvalue_("c")._size_(),"***", + o._getvalue_("b")._size_,"***",o._getvalue_("c")._getvalue_("e"); + **) //c结构体转换为tsl对象结构由于识别有限结果需要手工修改************************** -//function writeloglen(len); function MemoryAlignmentCalculate(data,baselen,ssize,pack); -function ReadStringFromPtr(ptr); -function WriteStringToPtr(ptr,str); +function ReadStringFromPtr(ptr,len); +function WriteStringToPtr(ptr,str,len); function ReadBytesFromPtr(ptr,L); +function widestr_ptr_len(ptr); //获取宽字符指针的数据长度 function WriteBytesToPtr(ptr,bytes); function parserctypestr(ts,t,s,n); -function dealcppcomment(strs); -function csstotslarray(csstr,tname); -function csstotslarray2(csstr,iv); -function csstotslarray3(ret,iv); -function cstructtotslclass(data,name,fs); -function tslarraytocstructcalc(data,alim,bsi,ssize);//计算对其长度 参数 data 结构体,alim 对其 默认为8;bsi 基础地址默认为0,ssize 结构体大小 返回值 -function ctypedefine(name,stc,alim,f);//结构体定义 +function tslarraytocstructcalc(data,alim,bsi,ssize);//计算对其长度 参数 data 结构体,alim对齐;bsi 基础地址默认为0,ssize 结构体大小 返回值 +function get_mem_mgr();//获取内存操作对象 //内存对象分配,释放类; type tmemoryclass=class {** @explan(说明)存对象分配,释放类 %% @param(_blocks)(array) 分配的内存块;以地址为索引的数组,值为分配的大小 %% - @param(_tool)(aefclassobj_) 内存管理底层工具 %% + @param(_tool)(t_mem_mgr) 内存管理底层工具 %% **} - protected - _blocks; //分配的内存块;以地址为索引的数组,值为分配的大小; - static _tool; public class function GetPointerSize(); begin @@ -178,9 +139,9 @@ type tmemoryclass=class begin {** @explan(说明)获取底层操作工具 %% - @return (aefclassobj_)内存底层管理工具 + @return (t_mem_mgr)内存底层管理工具 **} - if not ifobj(_tool)then _tool := new aefclassobj_(); + if not ifobj(_tool)then _tool := get_mem_mgr(); return _tool; end function create(); @@ -200,32 +161,16 @@ type tmemoryclass=class end _blocks := array(); end + protected + static _tool; + private + _blocks; //分配的内存块;以地址为索引的数组,值为分配的大小; end - - //旧的内存管理类,不支持**类型 + //内存管理类,不支持**类型 type ctslctrans = class(tmemoryclass) - (** - @example(范例--内存管理--1) - sa := array(("f","int",2), - ("a","char[3]","cd"), - ("b","user",(("c","char[5]","ab"), - ("d","int",5))), - ("c","user*",(("c","char[5]","ab"), - ("d","int",5), - ("e","char*","abcd"))) - - ); - data := tslarraytocstructcalc(sa); - o := new ctslctrans(data); - return echo o._size_(),"****", - o._getvalue_("c")._size_(),"***", - o._getvalue_("b")._size_,"***",o._getvalue_("c")._getvalue_("e"); - **) private Fstrcdata; _nomalloc; - //protected - //_blocks ;//分配的内存块;以地址为索引的数组,值为分配的大小; _ptr;//对象地址 _objs;//子对象 _objstart;//起始位置 @@ -274,7 +219,17 @@ type ctslctrans = class(tmemoryclass) ret := 1; end end - "intptr": + "int64": + begin + if ifnumber(v)then + begin + //echo "wirtptr\r\n"; + _tool.writeint64(p,v); + ret := 1; + end + ret := 1; + end + "intptr","pointer": begin if ifnumber(v)then begin @@ -366,6 +321,22 @@ type ctslctrans = class(tmemoryclass) ret := true; end end + "intptrarray","pointerarray": + begin + if arraynumberchek(v)and length(v)<= l then + begin + _tool.writeintptrs(p,length(v),v); + ret := true; + end + end + "int64array": + begin + if arraynumberchek(v)and length(v)<= l then + begin + _tool.writeint64s(p,length(v),v); + ret := true; + end + end "doublearray": begin if arraynumberchek(v)and length(v)<= l then @@ -475,7 +446,7 @@ type ctslctrans = class(tmemoryclass) raise "内存管理对象构造错误!"; return; end - _objsize := _objstart := _blocks := _objss := _objst := _objs := array(); + _objsize := _objstart := _objss := _objst := _objs := array(); ldata := length(data)-1; _size := data[ldata,3]+data[ldata,4]-data[0,3]; Fstrcdata := data; @@ -656,10 +627,14 @@ type ctslctrans = class(tmemoryclass) begin ret := _tool.readint(p); end - "intptr": + "intptr","pointer": begin ret := _tool.readptr(p); end + "int64": + begin + ret := _tool.readint64(p); + end "double": begin ret := _tool.readdouble(p); @@ -700,6 +675,14 @@ type ctslctrans = class(tmemoryclass) begin ret := _tool.readuints(p,l); end + "intptrarray","pointerarray": + begin + ret := _tool.readintptrs(p,l); + end + "int64array": + begin + ret := _tool.readint64s(p,l); + end "doublearray": begin ret := _tool.readdoubles(p,l); @@ -767,8 +750,9 @@ type ctslctrans = class(tmemoryclass) sz := _size_(); if ptr and sz>0 then begin - setlength(r,sz); - for i := 0 to sz-1 do r[i+1]:= _tool.readbyte(ptr+i); + return _tool.readbuf(ptr,sz); + //setlength(r,sz); + //for i := 0 to sz-1 do r[i+1]:= _tool.readbyte(ptr+i); end return r; end @@ -782,10 +766,11 @@ type ctslctrans = class(tmemoryclass) sz := _size_(); if ifstring(s)and ptr and sz>0 and sz <= length(s)then begin - for i := 0 to sz-1 do + _tool.writebuf(ptr,s,min(sz,length(s))); + {for i := 0 to min(sz,length(s))-1 do begin _tool.writebyte(ptr+i,ord(s[i+1])); - end + end} end end end @@ -822,23 +807,17 @@ end //*********字符串相关对象************************************** type tcbytearray=class - reallen; - len; //长度 - obj; //对象 {** @explan(说明) byte数组内存管理类 %% - @param(len)(integer) 数组占用长度 %% - @param(reallen)(integer) 实际内存长度 %% - @param(obj)(tslcstructureobj) 内存对象%% **} + public function create(n); begin {** @explan(说明)构造 %% - @param(n)(integer|array of integer) 字符串长度 预分配%% - + @param(n)(integer|array of integer) 字符串长度 预分配%% **} - reallen := len := 0; + foccupancy := fdatalen := 0; if not(n>0)then n := 128; setv(n); end @@ -849,23 +828,23 @@ type tcbytearray=class @param(n)(array of byte) 设置字的数组%% **} t := true; - if ifnumber(n)and n>0 and n>reallen then + if ifnumber(n)and n>0 and n>foccupancy then begin - len := reallen := n; - obj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",reallen),array(0))))); //tslcstructure(array((0,format("byte[%d]",reallen),array(0)))); + fdatalen := foccupancy := n; + fcmemobj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",foccupancy),array(0))))); //tslcstructure(array((0,format("byte[%d]",foccupancy),array(0)))); end else - if ifarray(n)and length(n)>reallen then + if ifarray(n)and length(n)>foccupancy then begin - len := reallen := length(n); - obj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",reallen),n)))); //tslcstructure(array((0,format("byte[%d]",reallen),n))); + fdatalen := foccupancy := length(n); + fcmemobj := new ctslctrans(MemoryAlignmentCalculate(array((0,format("byte[%d]",foccupancy),n)))); //tslcstructure(array((0,format("byte[%d]",foccupancy),n))); t := false; end - if ifarray(n)and t then + if ifarray(n) and t then begin - len := length(n); - obj._setvalue_(0,n); + fdatalen := length(n); + fcmemobj._setvalue_(0,n); end else - if ifnumber(n)and t then len := n; + if ifnumber(n)and t then fdatalen := n; end function occupancy(); begin @@ -873,7 +852,7 @@ type tcbytearray=class @explan(说明)获取内存占用 %% @return(integer) 占用大小 **} - return reallen; + return foccupancy; end function length(n); //设置长度 begin @@ -882,21 +861,20 @@ type tcbytearray=class @param(n)(integer|nil) nil为获取长度,数字为设置长度 %% **} if ifnumber(n)then reset(n); - return len; + return fdatalen; end function _getptr_(); begin {** @explan(说明)返回数组内存指针 %% **} - return obj._getptr_(); + return fcmemobj._getptr_(); end function setv(n);virtual; begin {** @explan(说明)设置byte数组 %% - @param(n)(array of byte) 数组%% - + @param(n)(array of byte) 数组%% **} return reset(n); end @@ -906,10 +884,7 @@ type tcbytearray=class @explan(说明)返回byte数组 %% @return(array of byte ) 返回的数组%% **} - if ifobj(obj)then - begin - return obj._getvalue_(0); - end + return fcmemobj._getvalue_(0); end function ptr(); begin @@ -918,11 +893,134 @@ type tcbytearray=class **} return _getptr_(); end + private + foccupancy;//容量 + fdatalen; //长度 + fcmemobj; //对象 +end +type tcbytearray=class + {** + @explan(说明) byte数组内存管理类 %% + **} + public + function create(n); + begin + {** + @explan(说明)构造 %% + @param(n)(integer|array of integer) 字符串长度 预分配%% + **} + fcmemobj := get_mem_mgr(); + foccupancy := fdatalen := 0; + if not(n>0)then n := 128; + setv(n); + end + function reset(n); + begin + {** + @explan(说明)重新设置 %% + @param(n)(array of byte) 设置字的数组%% + **} + t := true; + if ifnumber(n) and n>0 and n>foccupancy then + begin + fdatalen := foccupancy := n; + f_sptr := re_malloc(foccupancy); + t := false; + end else + if ifarray(n)and length(n)>foccupancy then + begin + fdatalen := foccupancy := length(n); + f_sptr := re_malloc(foccupancy); + end + if ifarray(n) and t then + begin + fdatalen := length(n); + fcmemobj.writebytes(f_sptr,fdatalen,n); + end else + if ifnumber(n) and t then fdatalen := n; + end + function occupancy(); + begin + {** + @explan(说明)获取内存占用 %% + @return(integer) 占用大小 + **} + return foccupancy; + end + function length(n); //设置长度 + begin + {** + @explan(说明)设置长度 或者获取数组的占用长度%% + @param(n)(integer|nil) nil为获取长度,数字为设置长度 %% + **} + if ifnumber(n)then reset(n); + return fdatalen; + end + function _getptr_(); + begin + {** + @explan(说明)返回数组内存指针 %% + **} + return f_sptr; + end + function setv(n);virtual; + begin + {** + @explan(说明)设置byte数组 %% + @param(n)(array of byte) 数组%% + **} + return reset(n); + end + function getv(); + begin + {** + @explan(说明)返回byte数组 %% + @return(array of byte ) 返回的数组%% + **} + //return fcmemobj.readbytes(f_sptr,fdatalen); + return fcmemobj.readbytes(f_sptr,foccupancy); + end + function ptr(); + begin + {** + @explan(说明)返回内存指针 %% + **} + return f_sptr; + end + function destroy(); + begin + free_ptr(); + end + private + function free_ptr(); + begin + if f_sptr then + begin + fcmemobj.tfree(f_sptr); + f_sptr := 0; + end + end + function re_malloc(n); + begin + if f_sptr then + begin + return fcmemobj.trealloc(f_sptr,n); + end + //free_ptr(); + r := fcmemobj.tmalloc(n); + fcmemobj.tmset(r,n); + return r; + end + private + f_sptr; + foccupancy;//容量 + fdatalen; //长度 + fcmemobj; //对象 end type tcstring=class(tcbytearray) {** @explan(说明)字符串内存管理类 %% - @param(_flag)(integer) 字符串是否包含\0结尾%% + @param(endzero)(bool) 默认为false字符串以\0结束 %%; **} private _flag; @@ -951,7 +1049,7 @@ type tcstring=class(tcbytearray) end end else begin - for i := 0 to reallen-1 do + for i := 0 to self.occupancy()-1 do begin vi := v[i]; if(vi=0)and nhn then break; @@ -978,9 +1076,6 @@ type tcstring=class(tcbytearray) class(tcbytearray).setv(r); end property endzero read _flag write _flag; - {** - @param(endzero)(bool) 默认为false字符串以\0结束 %%; - **} end type tcstructwithcharptr=class(ctslctrans) private @@ -1104,7 +1199,7 @@ type tcstructwithcharptr=class(ctslctrans) begin os := new tcstring(n); end else - os.setv(n); + os.setv(n); _strso[i]:= os; obj := class(ctslctrans); if obj._getvalue_(i)<> os.ptr then @@ -1114,985 +1209,875 @@ type tcstructwithcharptr=class(ctslctrans) if not ifnil(v)then obj._setvalue_(v,os.occupancy()-1); //修改 end end - - - //c结构体定义类 -type tcstruct= class - //_tag; - _size; //大小 - _maxitem; //最大元素 - _name; //名字 - _struct; //内存排布 - static _basetypes; //基础类型 - static _structs; //注册的结构体 +type t_mem_mgr = class() {** - @ignore 忽略%% - @explan(说明)c结构体定义类 %% - @param(_size)(integer) 大小%% - @param(_maxitem)(integer) 最大元素%% - @param(_name)(string) 名称%% - @param(_basetypes)(array) 基础类型表%% - @param(_structs)(array) 已经注册的结构体%% + @nickname(内存管理对象) %% + @explan(说明)内存操作底层接口 %% **} - type typeclass=class - _st; //开始位置; - _n; //名称 - _t; //类型名称 - _s; //size; - _mxi; //最大子项size - _fa; //数组标记 - _lt; //指针连接次数 - _ltp; //连接的类型 - _ms; //内存空间 - _ot; //原始类型; - _fb; //是否基础类型 - _stc; //结构 - _plen; //指针分配长度 - _wlen; //写的长度; - _oot; //原始字符串类型; - {** - @explan(说明)类型定义 %% - @param(_st)(integer) 开始位置%% - @param(_t)(string) 名称%% - @param(_mxi)(integer) 最大子项size%% - @param(_s)(integer) 大小%% - @param(_fa)(integer) 数组标记%% - @param(_lt)(integer) 指针连接次数%% - @param(_ltp)(string) 连接的类型%% - @param(_ms)(integer) 内存空间%% - @param(_ot)(string) 原始类型%% - @param(_fb)(integer) 是否基础类型%% - @param(_fb)(integer) 是否基础类型%% - @param(_stc)(tcstruct) 结构%% - @param(_plen)(integer) 指针分配长度%% - @param(_wlen)(integer) 写的长度%% - @param(_oot)(string) 原始字符串类型%% - **} - function show(i); - begin - {** - @explan(说明)展示 %% - @param(i)(integer) 展示标记%% - **} - if ifnil(i)then echo "\r\n字段,\t类型\t原型\t位置\t大小\t内存\t数组\t指针\t指向\t基类\t长度"; - echo "\r\n",_n,"\t",_t,"\t",_ot,"\t",_st,"\t",_s,"\t",_ms,"\t",_fa,"\t",_lt,"\t",_ltp,"\t",_fb,"\t",_plen; - end - function destroy(); - begin - _stc := nil; - end - function copy(); //对象复制 - begin - {** - @explan(说明)对象复制 %% - **} - o := new typeclass(); - o._st := _st; - o._n := _n; - o._t := _t; - o._s := _s; - o._mxi := _mxi; - o._fa := _fa; - o._lt := _lt; - o._ltp := _ltp; - o._ms := _ms; - o._ot := _ot; - o._fb := _fb; - o._wlen := _wlen; - o._plen := _plen; - o._oot := _oot; - if _stc is class(tcstruct)then - begin - o._stc := _stc.copy(); - end - return o; - end - end - function create(name,data,alim,fr); + function create(); begin - {** - @explan(说明)构造 %% - @param(name)(string) 名称%% - @param(data)(array) 内存分配%% - @param(alim)(integer) 对其方式%% - @param(fr)(integer) 类型判别%% - **} - _sinit_(); - if ifnil(name)then return; - if ifarray(name)then - begin - _name := name[0]; - _size := name[1]; - _maxitem := name[1]; - return 1; - end - if ifstring(name)then - begin - if pos("*,",name)=length(name)then raise "注册类体不能以*结尾"; - _name := name; - end else - raise "类型名称错误"; - if ifobj(_structs[name])and not(fr)then raise(name+"类型已经注册"); - ssize := 0; - tslarraytocstructcalcs(data,alim,ssize,maxitem); - if ifarray(data)and ssize>0 then - begin - _size := ssize; - _struct := data; - _maxitem := maxitem; - _structs[_name]:= self; - end - end - function hasstc(); //将结构hash化 - begin - {** - @explan(说明)将结构hash化 %% - **} - ret := array(); - for i,v in _struct do - begin - ret[v["n"]]:= v["tfo"]; - end - return ret; - end - function findstruct(n); //结构体查找 - begin - {** - @explan(说明)结构体查找 %% - @param(n)(string) 名称%% - **} - ov := new typeclass(); - typedeal(n,ov); - return ov; - end - function copy(); - begin - {** - @explan(说明)对象复制 %% - **} - o := new tcstruct(); - o._name := _name; - o._size := _size; - o._maxitem := _maxitem; - s := array(); - for i,v in _struct do - begin - s[i]:= v; - s[i]["tfo"]:= v["tfo"].copy(); - end - o._struct := s; - return o; - end - function show(); - begin - {** - @explan(说明)展示 %% - **} - echo "\r\n名称:",_name; - echo "\r\n内存大小:",_size; - echo "\r\n最大成员:",_maxitem; - echo "\r\n内存分布:"; //,tostn(_struct); - echo "\r\n字段,\t类型\t原型\t位置\t大小\t内存\t数组\t指针\t指向\t基类\t长度"; - for i,v in _struct do - begin - o := v["tfo"]; - o.show(1); - end - end - class function getptrchain(vt_,ret); //获得指针链条 - begin - {** - @explan(说明)获得指针链条 %% - @param(vt_)(string) 名称%% - @param(ret)() 返回%% - **} - vt := vt_; - ret := 0; - while(vt[length(vt)]="*") do - begin - ret += 1; - vt := vt[1:length(vt)-1]; - end - return vt; - end - class function setpptrchain(vt,n); //构造指针连 - begin - {** - @explan(说明)获得指针链条 %% - @param(n)(integer) 指针次数%% - @param(vt)(string) 类型名称%% - **} - ret := vt; - for i := 1 to n do - begin - ret += "*"; - end - return ret; - end - function typedeal(vt,ov,pt); //数组指针处理 char*[5] 表示5个指字符串 - begin - {** - @explan(说明)数组指针处理 char*[5] 表示5个指字符串 %% - **} - ov._oot := vt; - if not ifobj(ov)then raise "类型判断参数错误"; - {ctrl := "\\w+[*]*"; - ParseRegExpr(ctrl,vt,"",result,MPos,Mlen); - if length(result)>2 then raise "类型错误"; - vt_ := result[0,0]; - len := result[1,0];//大小 - ov._ot := vt_; //原型 - if len then //数组标记 - begin - sz := strtoint(len); - end - else - begin - sz := 0; - end } - parserctypestr(vt,vt_,len); - if len then sz := len; - else sz := 0; - pt := 0; - vt := getptrchain(vt_,pt); - ot := _structs[vt]; - if ifobj(ot)then //判断类型是否已经注册 - begin - o := ot; - if pt then //指针 - begin - o := _structs["pointer"]; - if sz>0 then - begin - vt := setpptrchain(vt,pt); - ov._ot := vt; - end else - begin - vt := setpptrchain(vt,pt-1); - ov._ot := vt; - end - ov._lt := pt; - ov._ltp := vt; - end - ov._s := o._size; //尺寸 - ov._mxi := o._maxitem; //最大子元素 - ov._t := o._name; //名称 - ov._fa := sz; //数组标记 - ov._fb := _basetypes[ov._ot]; //原型是否为基础类型; - _stc := _structs[ov._ot]; - if ifnil(_stc)then ov._stc := o.copy(); - else ov._stc := _stc.copy(); - end else - raise "类型不存在"; - return ret; - end - - function tslarraytocstructcalcs(data,alim,ssize,maxitem); //计算对其长度 - begin - {** - @explan(说明)计算对其长度 %% - - **} - if not ifnumber(alim)then - begin - {$ifdef linux} - alim := 4; - {$else} - alim := 8; - {$endif} - end - if preddata(data)=-1 then raise functionname()+"结构体数据错误!"; - npoint := 0; //开始位置 - names := data[:,"n"]; - len1 := length(names); - if(len1>length(names union2 array()))then raise functionname()+"结构体变量名重复"; - fmaxitem(data,alim); //对其长度 - maxitem := 0; - for i,vi in data do - begin - name := vi["n"]; //变量名 - ot := vi["tfo"]; //对象 - ot._n := name; - len := size := ot._fa; //数组 - tpbyte := ot._s; //当前占用的字节 - if maxitem(mcols(data)-1); - masthave := array("n","t"); - for i,v in masthave do - begin - if ifnil(cols[v])then return-1; - end - for i := 0 to length(data)-1 do - begin - data[i,"tfo"]:= new typeclass(); - end end - function fmaxitem(d,alim) //计算对其长度 - begin - ret := array(); - for i,v in d do - begin - vt := v["t"]; - vo := v["tfo"]; - typedeal(vt,vo); - end - return ret; - end; - -end - //新的内存管理类 -type tcpointer=class(tcstruct,tmemoryclass) - (** - @ignore 忽略%% - @example(范例--内存管理--2) - //tsl定义 - ts3 := ctypedefine("ts3",array(("n":"a","t":"char[3]"),("n":"b","t":"double"))); - ts2 := ctypedefine("ts2",array(("n":"a","t":"char[5]"),("n":"b","t":"int[3]"),("n":"e","t":"ts3"),("n":"c","t":"ts3*"))); - ts1 := ctypedefine("ts1",array(("n":"a","t":"char[3]"),("n":"m1","t":"ts2"))); - //构造c对应结构体指针,第一个参数为类名称,第二个为初始值 - o := new tcpointer("ts1",array( - "a":"ab", - "m1":array( - "a":"ef", - "b":array(2,3), - "e":array( - "a":"e", - "b":3 - ) - , - "c":array(//注意此处指针必须按照数组的形式 - array( - "a":"w", - "b":1.5 - ), - array( - "a":"tt", - "b":5 - ) - ) - ) - )); - 使用ctypedefine 定义和c交互的内存结构 - new tcpointer(定义的类型,初始值) 管理内存对象 - o.getindexi(i) 如果为数组或者指针返回第i个数据 - o._getdata_() 获得结构体中的所有数据已一个数组形式返回 - o._getvalue_("a") 根据索引获得数据 - o._setvalue_("a","ab") 赋值只能是基础类型,对于复杂类型可以按层级赋值,取值 - 例如: - o._getvalue_("m1")._setvalue_("a","f"); - echo tostn(o._getvalue_("m1")._getvalue_("c").getindexi(0)._getdata_); - echo tostn(o._getvalue_("m1")._getvalue_("c").getindexi(1)._getdata_); - **) - _ptr; //指针 - _desc; //描述 - _stc; //内存结构 - _hashstrc; //结构hash - _fpa; //数组标记; - _subobj; //子对象 - function create(sn,ivalue,ptr); //sn 名字,ivalue初始值,ptr 指针 - begin - //初始值 - class(tcstruct).create(); //类型获得 - class(tmemoryclass).create(); //内存操作对象 - mtool(); - _subobj := array(); - if ifobj(sn)then //不变 - begin - _desc := sn; - end else - begin - _desc := findstruct(sn); //类型描述 - _desc._st := 0; - _desc._ms := _desc._s; //内存大小描述 - end - if _desc._fa then _fpa := "a"; //数组 - else if _desc._lt then _fpa := "p"; - _stc := _desc._stc; //结构体描述 - _hashstrc := _stc.hasstc(); //便于查找的hash - if ptr and ifnumber(ptr)then - begin - _ptr := ptr; - end - //if ifnil(ivalue) then return ;//没有初始值返回 - if _fpa="a" then //数组 - begin - sz := _stc.getsteps(_desc._fa); //获得数组的分配空间 - n := _desc._t; //类型 - if not(_ptr)then //内存分配 - _ptr := tmalloc(sz,1); - if _desc._fb then //基础类型 - begin - if ifstring(ivalue)and n="char" then - begin - _write_(_ptr,n,ivalue,sz-1); - _desc._wlen := length(ivalue)+1; - end - if ifarray(ivalue)and n <> "char" then - begin - _write_(_ptr,n+"array",ivalue,length(ivalue)); - _desc._wlen := length(ivalue); - end - end else - begin - for i,v in ivalue do - begin - if i=_desc._fa then break; - n := _desc._ot; - _subobj[i]:= new tcpointer(n,v,_ptr+_stc.getsteps(i)); - end - end - end else - if _fpa="p" then //指针 - begin - if ifnumber(ivalue)then - begin - len := ivalue; - _desc._plen := len; - sz := _stc.getsteps(len); - if not(_ptr)then _ptr := tmalloc(sz,1); - end else - if ifarray(ivalue)then - begin - if _desc._ot="char" then raise "指针类型和赋值不符合"; - len := length(ivalue); - _desc._plen := len; - sz := _stc.getsteps(len); - if not(_ptr)then _ptr := tmalloc(sz,1); - if _desc._fb then //基础类型 - begin - _write_(_ptr,_desc._ot+"array",ivalue,len); - _desc._wlen := len; - end else - begin - for j,sv in ivalue do - begin - o := new tcpointer(_desc._ltp,sv,_ptr+_stc.getsteps(j)); - _subobj[j]:= o; - end - end - end else - if ifstring(ivalue)then - begin - if _desc._ot <> "char" then raise "字符串类型赋值错误"; - len := length(ivalue)+1; - _desc._plen := len; - sz := len; - if not(_ptr)then _ptr := tmalloc(sz,1); - _tool.writestr(_ptr,ivalue); - _desc._wlen := len; - end - end else //普通类型 - begin - if not(_ptr)then _ptr := tmalloc(_desc._s,1); - for i,v in ivalue do - begin - si := _hashstrc[i]; - if ifobj(si)then - begin - ptr := _ptr+si._st; //位置 - n := si._t; - if si._fa>0 then //数组 - begin - _subobj[i]:= new tcpointer(si,v,ptr); - end else - if si._lt>0 then //指针 - begin - o := new tcpointer(si,v); - _subobj[i]:= o; - _tool.writeptr(ptr,o._ptr); - end else //普通类型 - begin - if si._fb then - begin - _write_(ptr,n,v); - end else - begin - _subobj[i]:= new tcpointer(si,v,ptr); - end - end - end else - raise "赋值下标错误"; - end - end - end - function _getptr2_(); + function tmalloc(sz); begin {** - @explan(说明) 获取内存地址 %% + @explan(说明)内存分配 %% + @param(sz)(integer)大小 %% + @return(pointer)分配的内存的句柄 %% **} - x := 0; - for i,v in _objstart do - begin - x := v; - break; + if _tool then + return _tool.tmalloc(sz); + return TSL_Malloc(sz); + end + function trealloc(p,sz); + begin + {** + @explan(说明)重新内存分配 %% + @param(sz)(integer)大小 %% + @param(p)(pointer)内存地址 %% + @return(pointer)新的内存地址 %% + **} + if _tool then + return _tool.trealloc(p,sz); + return TSL_Realloc2(p,sz); + end + function tfree(p); + begin + {** + @explan(说明) 释放内存 %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.tfree(p); + return TSL_Free(p); + end + function tmcopy(d,s,sz); + begin + if _tool then + return _tool.tmcopy(d,s,sz); + return memcpy(d,s,sz); + end + function tmset(p,sz); + begin + {** + @explan(说明) 初始化内存 %% + @param(sz)(integer)大小 %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.tmset(p,sz); //set 0 + return memset(p,0,sz); + end + /////////////read///////////////////////////////////// + function readbyte(p); + begin + {** + @explan(说明) 读取一个byte %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readbyte(p); + r := 0; + memcpy_ptr_int(r,p,1); + return r; + end + function readint(p); + begin + {** + @explan(说明) 读取一个int %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readint(p); + r := 0; + memcpy_ptr_int(r,p,4); + return r; + end + function readuint(p); + begin + {** + @explan(说明) 读取一个uint %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readuint(p); + r := 0; + memcpy_ptr_int(r,p,4); + return r; + end + function readfloat(p); + begin + {** + @explan(说明) 读取一个float %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readfloat(p); + r := 0.0; + memcpy_ptr_Single(r,p,4); + return r; + end + function readptr(p); + begin + {** + @explan(说明) 读取一个pointer %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readptr(p); + r := 0L; + memcpy_ptr_pointer(r,p,fpointersize); + return r; + end + function readint64(p); + begin + {** + @explan(说明) 读取一个int64 %% + @param(p)(pointer)内存地址 %% + **} + 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; + end + r := 0L; + memcpy_ptr_int64(r,p); + return r; + end + function readdouble(p); + begin + {** + @explan(说明) 读取一个double %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readdouble(p); + r := 0.0; + memcpy_ptr_double(r,p,8); + return r; + end + function readstr(p); + begin + if _tool then + return _tool.readstr(p); + r:=""; + len := strlen(p); + setlength(r,strlen(p)); + memcpy1(r,p,len); + return r; + end + function readshort(p); + begin + {** + @explan(说明) 读取一个short %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readshort(p); + r := 0; + memcpy_ptr_int(r,p,2); + return r; + end + function readlong(p); + begin + {** + @explan(说明) 读取一个long %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readlong(p); + r := 0; + memcpy_ptr_int(r,p,4); + return r; + end + function readulong(p); + begin + {** + @explan(说明) 读取一个ulong %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.readulong(p); + r := 0; + memcpy_ptr_int(r,p,4); + return r; + end + function readints(p,sz); + begin + {** + @explan(说明) 读取一组int %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + 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); + begin + {** + @explan(说明) 读取一组uint %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readuints(p,sz); + return readints(p,sz); + end + function readint64s(p,sz); + begin + {** + @explan(说明) 读取一组double %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + 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 - return _getptr_()+x; + r := zeros(sz); + memcpy_ptr_int64s(r,p,sz*8); + return r; end - function _getptr_(); //获得地址 + function readdoubles(p,sz); begin - return _ptr; + {** + @explan(说明) 读取一组double %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readdoubles(p,sz); + r := zeros(sz); + memcpy_ptr_doubles(r,p,sz*8); + return r; end - function _size_(); //获得对象占用空间大小 + function readbytes(p,sz); begin - siz := _desc._size; - if _desc._fa then siz *= _desc._fa; - return siz; - end - function _getvalueaddr_(i); //获得值对应的内存地址 - begin - if ifnil(i)then return _ptr; - tv := _hashstrc[i]; - if ifobj(tv)then + {** + @explan(说明) 读取一组byte %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readbytes(p,sz); + s := ""; + setlength(s,sz); + memcpy1(s,p,sz); + r := array(); + for i := 1 to sz do begin - return _ptr+tv._st; //元素地址 - end - end - function _setcptr_(ptr); //设置对象地址 - begin - if ifnumber(ptr)and ptr then _ptr := ptr; - end - function _read_(p,t,l); //基本类型读取 - begin - case t of - "char": - begin - ret := _tool.readstr(p); - end - "int": - begin - ret := _tool.readint(p); - end - "intptr": - begin - ret := _tool.readptr(p); - end - "double": - begin - ret := _tool.readdouble(p); - end - "float": - begin - ret := _tool.readfloat(p); - end - "byte": - begin - ret := _tool.readbyte(p); - end - "short": - begin - ret := _tool.readshort(p); - end - "bytearray": - begin - ret := _tool.readbytes(p,l); - end - "intarray": - begin - ret := _tool.readints(p,l); - end - "doublearray": - begin - ret := _tool.readdoubles(p,l); - end - end; - return ret; - end - function _write_(p,t,v,l); //基本类型写入 - begin - case t of - "char": - begin - if ifstring(v)then - begin - if ifnumber(l)and length(v)>l then - begin - //echo "\r\nstringwrite:",l,"****",length(v); - return-1; - end - _tool.writestr(p,v); - ret := 1; - end - end - "int": - begin - if ifnumber(v)then - begin - _tool.writeint(p,v); - ret := 1; - end - end - "intptr": - begin - if ifnumber(v)then - begin - _tool.writeptr(p,v); - ret := 1; - end - ret := 1; - end - "double": - begin - if ifnumber(v)then - begin - _tool.writedouble(p,v); - ret := 1; - end - end - "float": - begin - if ifnumber(v)then - begin - _tool.writefloat(p,v); - ret := 1; - end - end - "byte": - begin - if ifnumber(v)then - begin - _tool.writebyte(p,v); - ret := 1; - end - end - "short": - begin - if ifnumber(v)then - begin - _tool.writeshort(p,v); - ret := 1; - end - end - "bytearray": - begin - _tool.writebytes(p,min(length(v),l),v); - ret := true; - end - "intarray": - begin - _tool.writeints(p,min(length(v),l),v); - ret := true; - end - "doublearray": - begin - _tool.writedoubles(p,min(length(v),l),v); - ret := true; - end - end; - return ret; - end - function _getdata_(); //获得所有的数据 - begin - t := _desc._ot; - fp := _fpa; - if fp="a" then - begin - if _desc._fb then - begin - if t="char" then - begin - //echo "\r\nreade:",_ptr; - v := _tool.readstr(_ptr); - return v; - end else - begin - return _read_(_ptr,t+"array",_desc._fa); - end - end else - begin - ret := array(); - for i := 0 to _desc._fa-1 do - begin - ret[i]:= getindexi(i)._getdata_(); - end - return ret; - end - end else - if fp="p" then - begin - t := _desc._ot; - if _desc._fb then - begin - if t="char" then - begin - return _tool.readstr(_ptr); - end else - begin - return _read_(_ptr,t+"array",_desc._plen); - end - end else - begin - ret := array(); - if ifnumber(_desc._plen)then - begin - for i := 0 to _desc._plen-1 do - begin - ret[i]:= getindexi(i)._getdata_(); - end - end - return ret; - end - end else - begin - ret := array(); - for i,v in _hashstrc do - begin - n := v._n; - o := _getvalue_(n); - if ifobj(o)then ret[n]:= o._getdata_(); - else ret[n]:= o; - end - return ret; - end - end - function getindexi(i); //获得数组或者指针第i个元素,基础类型返回值,复杂类型返回对象 - begin - if(_fpa="a" and i >= 0 and i<_desc._fa)then // - begin - //基础类型 - ret := _subobj[i]; - if ifobj(ret)then return ret; - psi :=(_desc._s * i+_ptr); - if not(_desc._fb)then //非基础类型 - begin - return new tcpointer(_desc._t,nil,psi); - end else //基础类型 - begin - if _desc._t <> "char" then - begin - return _read_(psi,_desc._ot); - end - end - end else - if _desc._lt>0 and i >= 0 then - begin - ret := _subobj[i]; - if ifobj(ret)then return ret; - ps := _ptr; - if ps=0 then return nil; - if _desc._lt>1 then - begin - psi :=(ps+_desc._ms * i); - o := new tcpointer(_desc._ot,nil,psi); - _subobj[i]:= o; - return o; - end else - begin - psi := ps+(_desc._stc._size * i); - if not(_desc._fb)then //非基础类型 - begin - o := new tcpointer(_desc._ot,nil,psi); - _subobj[i]:= o; - return o; - end else //基础类型 - begin - if _desc._ot <> "char" then - begin - return _read_(psi,_desc._ot); - end else - return _read_(psi,"char"); - end - end - end - end - function _setvalue_(i,v); //给下标字段设置值,只支持基础类型 - begin - if ifnil(i)then - begin - ds := _desc; - //ds.show(); - end else - ds := _hashstrc[i]; - if not ifobj(ds)then return nil; - ptr := _ptr+ds._st; - if ds._fb then //基础类型 - begin - if not(ds._fa or ds._lt)then //非数组或者指针 - begin - _write_(ptr,ds._t,v); - end else - if ds._fa then - begin - if ds._ot="char" and ifstring(v)then - begin - _write_(ptr,ds._ot,v,ds._fa); - end else - if ds._ot <> "char" and ifarray(v)then - begin - _write_(ptr,ds._ot+"array",v,ds._fa); - end - end else - if ds._lt then //指针 - begin - if(v is class(tcpointer))then //设置值 - begin - if(ds._ot=v._desc._ot)and(ds._lt=v._desc._lt)then - begin - begin - _subobj[i]:= v; - _write_(ptr,"intptr",v._ptr); - end - end - return; - end - ptr := _read_(ptr,"intptr"); - if ptr then - begin - if ds._ot="char" and ifstring(v)and(length(v) "char" and ifarray(v)then - begin - _write_(ptr,ds._ot+"array",v,ifnumber(ds._plen)?(ds._plen):(length(v))); - end - end - end - end - end - function _getvalue_(i,L); //获取值,支持基础类型,i为下标,l在为指针的时候指定长度 - begin - v := _hashstrc[i]; - if not ifobj(v)then return nil; - ptr := _ptr+v._st; - t := v._ot; - if v._fb then //基础类型 - begin - if v._fa then - begin - if v._ot="char" then return _read_(ptr,"char"); - return _read_(ptr,v._ot+"array",ifnumber(L)?min(v._fa,L):v._fa); - end else - if v._lt then - begin - ptr := _read_(ptr,"intptr"); - if ptr <> 0 then - begin - if v._ot="char" then return _read_(ptr,"char"); - return _read_(ptr,v._ot+"array",ifnumber(L)?L:v._plen); - end - end else - begin - return _read_(ptr,v._ot); - end - end else - begin - if not ifobj(_subobj[i])then - begin - if v._fa then //数值 - begin - _subobj[i]:= new tcpointer(v,nil,ptr); - end else - if v._lt then //指针 - begin - ptr := _read_(ptr,"intptr"); - if ptr <> 0 then - begin - _subobj[i]:= new tcpointer(v,nil,ptr); - end - end else - begin - //echo v.show; - _subobj[i]:= new tcpointer(v,nil,ptr); - end - end - return _subobj[i]; - end - end - function destroy(); //析构 - begin - _subobj := array(); - class(tmemoryclass).destroy(); - end - function activefree(); //主动析构,目前不完善,需要等结构体调整好后补充 - begin - if _desc._lt then activefreesub(ptr_); - end - protected - function activefreesub(ptr_); - begin - ptr := opblocks(ptr_,0); - if ifnil(ptr)then - begin - _tool.tfree(ptr_); - end - end -end + r[i-1] := ord(s[i]); + end + return r; + end + function readshorts(p,sz); + begin + {** + @explan(说明) 读取一组short %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readshorts(p,sz); + r := ones(sz); + memcpy_ptr_shorts(r,p,sz*2); + return r; + end + function readushorts(p,sz); + begin + {** + @explan(说明) 读取一组short %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readushorts(p,sz); + return readshorts(p,sz); + end + function readfloats(p,sz); + begin + {** + @explan(说明) 读取一组float %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readfloats(p,sz); + r := ones(sz); + memcpy_ptr_Single(r,p,sz*4); + return r; + end + function readintptrs(p,sz); + begin + {** + @explan(说明) 读取一组intptr %% + @param(p)(pointer)内存地址 %% + @param(sz)(pointer)大小 %% + **} + if _tool then + return _tool.readintptrs(p,sz); + r := ones(sz); + memcpy_ptr_pointers(r,p,sz*fpointersize); + return r; + //return memcpy_ptr_pointer(p); + end + ////////////////////write////////////////////////////////////////////////// + function writebyte(p,v); + begin + {** + @explan(说明) 写入一个beyte %% + @param(p)(pointer)内存地址 %% + @param(v)(integer)值 %% + **} + if _tool then + return _tool.writebyte(p,v); + memcpy_int_ptr(p,v,1); + return 1; + end + function writeint(p,v); + begin + if _tool then + return _tool.writeint(p,v); + memcpy_int_ptr(p,v,4); + return 1; + end + function writeuint(p,v); + begin + if _tool then + return _tool.writeuint(p,v); + return writeint(p,v); + end + function writefloat(p,v); + begin + if _tool then + return _tool.writefloat(p,v); + memcpy_Single_ptr(p,v,4) ; + return 1; + end + function writeptr(p,v); + begin + {** + @explan(说明) 写入一个pointer%% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeptr(p,v); + memcpy_pointer_ptr(p,v,fpointersize); + return 1; + end + function writeint64(p,v); + begin + {** + @explan(说明) 写取一个int64 %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + begin + if fpointersize=8 then return _tool.writeptr(p,v); + 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); + end + memcpy_int64_ptr(p,v,8); + return 1; + end + function writedouble(p,v); + begin + {** + @explan(说明) 写一个double %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writedouble(p,v); + memcpy_double_ptr(p,v,8); + return 1; + end + function writestr(p,v); + begin + if _tool then + return _tool.writestr(p,v); + memcpy2(p,v,strlen1(v)); + return 1; + end + function writeshort(p,v); + begin + {** + @explan(说明) 写入一个short%% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeshort(p,v); + memcpy_int_ptr(p,v,2); + return 1; + end + function writeushort(p,v); + begin + {** + @explan(说明) 写入一个ushort%% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeushort(p,v); + return writeshort(p,v); + end + function writelong(p,v); + begin + {** + @explan(说明) 写入一个long%% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writelong(p,v); + return writeint(p,v); + end + function writeulong(p,v); + begin + {** + @explan(说明) 写入一个ulong%% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeulong(p,v); + return writelong(p,v); + end + function writeints(p,sz,v); + begin + {** + @explan(说明) 写入一组int %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeints(p,sz,v); + return memcpy_int_ptrs(p,v,sz*4); + end + function writeuints(p,sz,v); + begin + {** + @explan(说明) 写入一组int %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeuints(p,sz,v); + return writeints(p,sz,v); + end + + function writeint64s(p,sz,v); + begin + {** + @explan(说明) 写入一组int %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + begin + if fpointersize=8 then return writeintptrs(p,sz,v); + len := min(sz,length(v)); + for i:= 0 to len-1 do + begin + writeint64(p+i*fpointersize,v[i]); + end + return 1; + end + memcpy_int64_ptrs(p,sz,v*8); + return 1; + end + function writedoubles(p,sz,v); + begin + {** + @explan(说明) 写入一组int %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writedoubles(p,sz,v); + memcpy_double_ptrs(p,v,sz*8); + return 1; + end + function writebytes(p,sz,v); + begin + {** + @explan(说明) 写入一组short %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writebytes(p,sz,v); + r := ""; + setlength(r,sz); + for i:=1 to sz do + begin + r[i] := v[i-1]; + end + memcpy2(p,r,sz); + return 1; + end + function writeshorts(p,sz,v); + begin + {** + @explan(说明) 写入一组short %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeshorts(p,sz,v); + memcpy_short_ptrs(p,v,sz*2); + return 1; + end + function writeushorts(p,sz,v); + begin + {** + @explan(说明) 写入一组ushort %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeushorts(p,sz,v); + return writeshorts(p,sz,v); + end + function writefloats(p,sz,v); + begin + {** + @explan(说明) 写入一组float %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writefloats(p,sz,v); + memcpy_Single_ptrs(p,v,sz*4); + return 1; + end + function writeintptrs(p,sz,v); + begin + {** + @explan(说明) 写入一组intptr %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeintptrs(p,sz,v); + memcpy_pointer_ptrs(p,v,sz*fpointersize); + return 1; + end + function writelongs(p,sz,v); + begin + {** + @explan(说明) 写入一组intptr %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writelongs(p,sz,v); + return writeints(p,sz,v); + end + function writeulongs(p,sz,v); + begin + {** + @explan(说明) 写入一组long %% + @param(p)(pointer)内存地址 %% + **} + if _tool then + return _tool.writeulongs(p,sz,v); + return writelongs(p,sz,v); + end + function readbuf(p,n); + begin + s := ""; + if not(n>0) then return s; + setlength(s,n); + memcpy1(s,p,n); + return s; + end + function writebuf(p,s,n); + begin + if not(s and ifstring(s)) then return 0; + if ifnil(n) then n := length(s); + return memcpy2(p,s,n) ; + end + private + function TSL_Malloc(sz:pointer):pointer; + begin + _f_ := static function(sz:pointer):pointer;cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Malloc"); + return ##_f_(sz); + end + function TSL_Free(ptr:pointer):pointer; + begin + _f_ := static procedure(ptr:pointer);cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Free"); + return ##_f_(ptr); + end + function TSL_Realloc2(ptr:pointer;sz:pointer):pointer; + begin + _f_ := static function(ptr:pointer;sz:pointer):pointer;cdecl;external getdlsymaddress(get_tsapi_dll(),"TSL_Realloc2"); + return ##_f_(ptr,sz); + end + function memset(ptr:pointer;ch:integer;size_t:pointer):pointer; + begin + _f_ := static function(ptr:pointer;ch:integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memset"); + return ##_f_(ptr,ch,size_t); + end + function strlen(ptr:pointer):pointer; + begin + _f_ := static function(ptr:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"strlen"); + return ##_f_(ptr); + end + function strlen1(var ptr:string):pointer; + begin + _f_ := static function(var ptr:string):pointer;cdecl;external getdlsymaddress(get_std_dll(),"strlen"); + return ##_f_(ptr); + end + ///////////////////int///////////////////////////////////// + function memcpy_ptr_int(var dst:integer;src:pointer;size_t:pointer):pointer; + 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; + begin + _f_ := static function(dst:pointer;var src:integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_int_ptrs(dst:pointer;src:array of integer;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;src:array of integer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + //////////////////////////////////////////////////////////////////////////////// + ////////////////////////// short //////////////////////////////////////////////// + function memcpy_short_ptrs(dst:pointer;src:array of short;size_t:pointer):pointer; + 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 + ////////////////////////////////////////////////////////////////// + //////////////////////////////double///////////////////////////////////// + function memcpy_ptr_double(var dst:double;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:double;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + r := ##_f_(dst,src,size_t); + return r; + end + function memcpy_ptr_doubles(var dst:array of double;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:array of double;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + r := ##_f_(dst,src,size_t); + return r; + end + function memcpy_double_ptr(dst:pointer;var src:double;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;var src:double;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_double_ptrs(dst:pointer;var src:array of double;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;var src:array of double;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + /////////////////////////////////////////////////////////////////////////////// + ///////////////////////////float///////////////////////////////////////////////// + function memcpy_ptr_Single(var dst:Single;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:Single;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + r := ##_f_(dst,src,size_t); + return r; + end + function memcpy_ptr_Singles(var dst:array of Single;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:array of Single;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + r := ##_f_(dst,src,size_t); + return r; + end + function memcpy_Single_ptr(dst:pointer;var src:Single;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;var src:Single;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_Single_ptrs(dst:pointer;src: array of Single;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;src: array of Single;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + ////////////////////////////////////////////////////////////////////////////////////// + ///////////////////////////////pointer///////////////////////////////////////////////////// + function memcpy_ptr_pointer(var dst:pointer;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_ptr_pointers(var dst:array of pointer;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:array of pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_pointer_ptr(dst:pointer;var src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;var src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy_pointer_ptrs(dst:pointer;var src: array of pointer;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;var src:array of pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + /////////////////////////////////////////////////////////////////////////////////// + ///////////////////////////////int64//////////////////////////////////////////////// + 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); + 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); + 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); + end + function memcpy_int64_ptrs(dst:pointer;src:array of int64;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;src:array of int64;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + //////////////////////////string///////////////////////////////////////////////////// + function memcpy(dst:pointer;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy1(var dst:string;src:pointer;size_t:pointer):pointer; + begin + _f_ := static function(var dst:string;src:pointer;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy2(dst:pointer ;src:string;size_t:pointer):pointer; + begin + _f_ := static function(dst:pointer ;src:string;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + function memcpy3(var dst:string ;var src:string;size_t:pointer):pointer; + begin + _f_ := static function(dst:string ;src:string;size_t:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"memcpy"); + return ##_f_(dst,src,size_t); + end + /////////////////////////////////////////////////////////////////////////////////////////// + function get_tsapi_dll(); + begin + {$ifdef linux} + return "libTSLkrnl.so";//"libTSSVRAPI.so"; + {$else} + return "TSLkrnl.dll";//"tssvrapi.dll"; + {$endif} + end + function get_std_dll(); + begin + {$ifdef linux} + return "libdl.so.2"; + {$else} + return "msvcrt.dll"; + {$endif} + end + public + function wcslen(ptr:pointer):pointer; + begin + _f_ := static function(ptr:pointer):pointer;cdecl;external getdlsymaddress(get_std_dll(),"wcslen"); + return ##_f_(ptr); + end + function wcslen1(ptr:string):pointer; + begin + _f_ := static function(ptr:string):pointer;cdecl;external getdlsymaddress(get_std_dll(),"wcslen"); + return ##_f_(ptr); + end + private + fpointersize; + _tool; +end Implementation -function ReadStringFromPtr(ptr); +function widestr_ptr_len(ptr); //获取宽字符指针的数据长度 +begin + mg := get_mem_mgr(); + if ptr>0 or ptr<0 then + begin + return mg.wcslen(ptr); + end +end +function ReadStringFromPtr(ptr,n); begin {** @explan(说明) 读取一个指向\0字符串指针的值 %% @param(ptr)(pointer) 指针 %%; + @param(n)(integer) 长度,不给以\0作为长度 %%; @return(string) 字符串 %% **} - if ptr and ifnumber(ptr)then return getmemtool().readstr(ptr); + if ptr>0 or ptr<0 then + begin + if n>0 then + begin + return get_mem_mgr().readbuf(ptr,n); + end else + begin + return get_mem_mgr().readstr(ptr); + end + end return ""; end -function WriteStringToPtr(ptr,str); +function WriteStringToPtr(ptr,s,len); begin {** @explan(说明) 向一个指针写入\0结尾的字符串 %% @param(ptr)(pointer) 指针 %%; - @param(str)(string) 字符串 %% + @param(s)(string) 字符串 %% + @param(len)(integer) 指定写入长度 %% **} - if ifnumber(ptr)and ifstring(str)and ptr then return getmemtool().writestr(ptr,str); + if ifstring(s) and (ptr>0 or ptr<0) then + begin + if len>0 then + begin + return get_mem_mgr().writebuf(p,s,len); + end else + return get_mem_mgr().writestr(ptr,s); + end return 0; end function ReadBytesFromPtr(ptr,L); @@ -2103,7 +2088,7 @@ begin @param(L)(integer) 长度 %%; @return(array of integer) 字符串 %% **} - if ptr and ifnumber(ptr)and L>0 then return getmemtool().readbytes(ptr,L); + if ptr and (ptr>0 or ptr<0)and L>0 then return get_mem_mgr().readbytes(ptr,L); end function WriteBytesToPtr(ptr,bytes); begin @@ -2112,12 +2097,16 @@ begin @param(ptr)(pointer) 指针 %%; @param(bytes)(array of integer) 数据 %% **} - if ifnumber(ptr)and ptr and ifarray(bytes)then return getmemtool().writebytes(ptr,length(bytes),bytes); + if ifnumber(ptr)and ptr and ifarray(bytes)then return get_mem_mgr().writebytes(ptr,length(bytes),bytes); return 0; end -function getmemtool(); +function get_mem_mgr(); begin - return static new aefclassobj_(); +{** + @explan(说明) 获取内存管理对象 %% + @return(t_mem_mgr) +**} + return static new t_mem_mgr();//aefclassobj_(); end function MemoryAlignmentCalculate(data,baselen,ssize,pack); begin @@ -2138,20 +2127,12 @@ begin pack := 8; //对齐 {$endif} end - //return tslcstructure_calc(data,baselen,ssize,pack); return tslarraytocstructcalc(data,pack,0,ssize); end -function ctypedefine(name,stc,alim,f); //结构体定义 +function is_validate_type(tp); begin - {** - @explan(说明)结构体定义 %% - @param(name)(string) 名称 %% - @param(stc)(array) 内存分布 %% - @param(alim)(integer) 对其方式 %% - @return(tcstruct) - **} - return new tcstruct(name,stc,alim,f); -end + return array("uint":1,"char":1,"float":1,"double":1,"int":1,"intptr":1,"pointer":1,"int64":1,"byte":1,"short":1,"char*":1,"user*":1)[tp]; +end function tslarraytocstructcalc(data,alim,bsi,ssize); //计算对其长度 begin {** @@ -2211,7 +2192,7 @@ begin names := data[:,0]; len1 := length(names); if(len1>length(names union2 array()))then raise functionname()+"结构体变量名重复"; - ctypebytes := static getctypesize(); + ctypebytes := static get_c_typesize();;//getctypesize(); ctypebytes["user*"]:= ctypebytes["intptr"]; ctypenames := mrows(ctypebytes,1); itemslen := calcalimsizeA(data,ctypebytes);//对其长度 @@ -2220,15 +2201,10 @@ begin name := vi[0]; //变量名 tp := vi[1]; //变量类型 v := vi[2]; //变量值 - ctrl := "\\w+[*]?"; - {ParseRegExpr(ctrl,tp,"",result,MPos,Mlen); - tp1 := result[0,0]; //类型 - size := result[1,0];//大小 - if ifstring(size) then size := strtoint(size);} parserctypestr(tp,tp1,size); //echo "*************************",size; tpbyte := itemslen[i]; //当前占用的字节 - if(tp1 in array("uint","char","float","double","int","intptr","byte","short","char*","user*"))then + if is_validate_type(tp1)then begin tpn := tp1; ret[i,5]:= tpn; @@ -2279,7 +2255,7 @@ begin ret1 := tslarraytocstructcalc(v,alim,npoint,sz); ret[i,2]:= ret1; end else - raise "类型错误"; + raise "类型错误"; ret[i,3]:= npoint; //元素开始的地址 ret[i,4]:= sz; //元素占用空间 ret[i,6]:= size; //元素个数 @@ -2297,9 +2273,6 @@ begin for i,v in d do begin vt := v[1]; - {ctrl := "\\w+[*]?"; - ParseRegExpr(ctrl,vt,"",result,MPos,Mlen); - vt := result[0,0];} parserctypestr(vt,tt,len); vt := tt; //echo tt,"\r\n"; @@ -2359,280 +2332,72 @@ begin i++; end end -function addtable(d,n); +function get_c_typesize() //获取类型大小 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注释***************** -function dealcppcomment(strs) -begin - {** - @explan(说明)删除c语言注释 %% - @param(strs)(string) c结构体字符串 %% - @return(string) - **} - rets := ""; - len := length(strs); - i := 1; - while i>>>gettype"; 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); + { + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "int"), sizeof(int)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "uint"), sizeof(unsigned int)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "char*"), sizeof(char*)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "intptr"), sizeof(INT_PTR)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "SHORT"), sizeof(SHORT)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "BOOL"), sizeof(BOOL)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "char"), sizeof(char)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "double"), sizeof(double)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "short"), sizeof(short)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "ushort"), sizeof(unsigned short)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "long"), sizeof(long)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "ulong"), sizeof(unsigned long)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "LONG"), sizeof(LONG)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "bool"), sizeof(bool)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "byte"), sizeof(byte)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "BYTE"), sizeof(BYTE)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "WORD"), sizeof(WORD)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "DWORD"), sizeof(DWORD)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "word"), sizeof(WORD)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "dword"), sizeof(DWORD)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "float"), sizeof(float)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "FLOAT"), sizeof(FLOAT)); + TSL_SetInt(L, TSL_HashSetItemSZString(L, Value, "pointer"), sizeof(INT_PTR)); + } + return 1; 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 - Initialization //Unit Initial statement here Finalization diff --git a/funcext/tvclib/getdlsymaddress.tsf b/funcext/tvclib/getdlsymaddress.tsf index 47c6ecf..6e5f83b 100644 --- a/funcext/tvclib/getdlsymaddress.tsf +++ b/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 diff --git a/funcext/tvclib/parserch.tsf b/funcext/tvclib/parserch.tsf index ef6ac34..adbd59a 100644 --- a/funcext/tvclib/parserch.tsf +++ b/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 i2 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); diff --git a/funcext/tvclib/utslvclgdi.tsf b/funcext/tvclib/utslvclgdi.tsf index 6be0d24..0f987f9 100644 --- a/funcext/tvclib/utslvclgdi.tsf +++ b/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) @@ -833,10 +883,12 @@ type tcustomimage=class(TSLUIBASE) FGdi; Static FImageTypes; class function GetFileType(t_); - begin + begin if not(t_ and ifstring(t_))then t := "png"; - else t := lowercase(t_); + 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(); @@ -3381,59 +3514,4 @@ class(tUIglobalData).uisetdata("G_T_BITMAP_",class(TcustomBitmap)); 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 -*) \ No newline at end of file +end. \ No newline at end of file diff --git a/funcext/tvclib/utvclgraphics.tsf b/funcext/tvclib/utvclgraphics.tsf index a02ea8c..2bc77b6 100644 --- a/funcext/tvclib/utvclgraphics.tsf +++ b/funcext/tvclib/utvclgraphics.tsf @@ -4,6 +4,7 @@ uses utslvclauxiliary; //tsl绘图库 //20240126 //20240204 添加说明 +//20240220 三维绘图功能 { tg_const 常量类型，作为所有类型的基类，提供常量别名 tg_canvas 绘图画布对象，该对象以窗口中的canvas为父类，并增加了辅助函数 @@ -36,8 +37,8 @@ uses utslvclauxiliary; line_mode 是否画线 mark_mode 是否画点的标记 clip_state 是否裁剪区域 - Coordinate_Mapping(x,y,z,var _x,var _y) 通过坐标点计算画布点位置 - Coordinate_unMapping(x,y,var x_,var y_,var z_) 通过画布点计算坐标点 + zoom_to_xyz(x,y,z,var _x,var _y) 通过坐标点计算画布点位置 + xyz_to_zoom(x,y,z,var x_,var y_,var z_) 通过画布点计算坐标点 set_lineinfo_to_canvas(cvs,peninfo) 设置当前画笔信息到画布 set_fontinfo_to_canvas(cvs,info) 设置当前字体信息到画布 paint(cvs);virtual;该函数由tg_figure的管理者在适当时候发起，并送入tg_canvas对象 @@ -68,10 +69,10 @@ uses utslvclauxiliary; grid(idx) 背景网格线属性 tg_line_info 对象，size为0的时候网格线消失 tg_axis 坐标轴，可以在坐标系中放置任意多个坐标轴 - tics_direction 坐标轴方向 tgc_left tgc_right tgc_bottom tgc_top + tics_direction 坐标轴方向 tgc_direct_asc(坐标轴指向的左手方向) , tgc_direct_desc tics_style 刻度类型 tgc_tics_v (设置值) tgc_tics_r ([x0,x1,inteval]) - xtics_coord 刻度，根据tics_style 确定 [2,3,4,5,6,7] 计算 [start,end,interval] - ytics_coord 位置，设置在另一个方向的位置，相对坐标系的数据位置 + tics_coord 刻度，根据tics_style 确定 [2,3,4,5,6,7] 计算 [start,end,interval] + ytics_coord 位置，设置在另一个方向的位置，相对坐标系的数据位置,array(x,y,z),为对应三维坐标,x,y,z中为非数字的值表示该坐标轴在对应维度上面 tics_segment 是否有轴线 tics_color 刻度线颜色 sub_tics 子刻度个数 @@ -114,7 +115,7 @@ uses utslvclauxiliary; 其仅仅作为一个案例，用户可以按照其原理构造自己的画布对象，驱动绘制，得到图形 } { -//////////////////绘图范例////////////////////////// +//////////////////线图范例////////////////////////// uses tslvcl,utvclgraphics; app := initializeapplication(); app.createform(class(tfm),fm); @@ -124,6 +125,7 @@ type tfm = class(tvcform) function create(aowner); begin inherited; + Caption := "line"; fg := new tg_WinControl(self); fg.Caption := "hello1"; fg.parent := self; @@ -134,15 +136,12 @@ type tfm = class(tvcform) axs.title.text := "你好 plot "; axs.title.fontinfo.size := 15; axs.title.fontinfo.color := 0xff0000; - axs.x_label.text := "x fanli "; - + axs.x_label.text := "x fanli "; axs.axises(1).tics_color := 0x0000ff; - axs.axises(1).fontinfo.size := 8; - + axs.axises(1).fontinfo.size := 8; axs.axises(1).lineinfo.color := 0x00ff00; axs.grid(0).Width := 2; - axs.grid(0).color := 0x0ff0f0; - + axs.grid(0).color := 0x0ff0f0; //设置线型属性 line := new tg_Polyline(); line.lineinfo.style := 4; @@ -165,8 +164,195 @@ type tfm = class(tvcform) end fg; end +//////////////////表面图范例/////////////////////////////////////// +uses tslvcl,utvclgraphics; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + Caption := "surface"; + fg := new tg_WinControl(self); + fg.Caption := "hello1"; + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + t := pi()*60/180; + a := pi()*70/180; + axs.set_trans(a,t); + axs.box := true; + axs.figure := fg.figure; + axs.title.text := "你好 surface "; + axs.title.fontinfo.size := 15; + axs.title.fontinfo.color := 0xff0000; + axs.axises(1).tics_color := 0x0000ff; + axs.axises(1).fontinfo.size := 8; + axs.axises(1).lineinfo.color := 0x00ff00; + sf := new tg_my_surf(); + sf.lineinfo.color := 0x0000ff; + sf.lineinfo.style := tgc_BS_SOLID; + sf.graph_data := get_surf_data(); + sf.parent := axs; + return ; + end + fg; + function c_3(x,y); + begin + return X - 3*X*sin(X)*cos(Y-4) ; + end + function get_surf_data(); + begin + st1 := (12)/50; + vs1 := array(-10,st1)->2; + st2 := 10/50; + vs2 := array(-5,st2)->5; + d := array(); + dlen := 0; + for i,vi in vs1 do + begin + for j,vj in vs2 do + begin + r := array(); + x0 := vi; + y0 := vj; + x1 := vi+st1; + y1 := vj+st2; + v1 := array(x0,y0,c_3(x0,y0)); + v2 := array(x1,y0,c_3(x1,y0)); + v3 := array(x1,y1,c_3(x1,y1)); + v4 := array(x0,y1,c_3(x0,y1)); + d[dlen++] := array(v1,v2,v3,v4,v1); + end + end + return d; + end +end +type tg_my_surf = class(tg_graph) //绘图对象,包括数据,提示等内容 + function create(pms); + begin + inherited; + lineinfo.bkcolor := 0x00f0f0; + end + function get_data_bounds();override; + begin + d := graph_data; + r := array((inf,-inf),(inf,-inf),(inf,-inf)); + for i ,v in d do + begin + for j,vj in v do + begin + for k := 0 to 2 do + begin + r[k,0] := min(r[k,0],vj[k]); + r[k,1] := max(r[k,1],vj[k]); + end + end + end + for k := 0 to 2 do + begin + r[k,0] -= abs(r[k,0]*0.1); + r[k,1] += abs(r[k,1]*0.1); + end + return r; + end + function paint_legend(cvs,rec);virtual; //绘制图例 + begin + end + function paint(cvs);override; + begin + d := graph_data; + cvs.axesclip(); + set_lineinfo_to_canvas(cvs); + dp := cvs.draw_polygon(); + bx := axes.zoom_box; + //cvs.pen.color := 0xff0000; + for i,v in d do + begin + ps := array(); + flg := false; + zz := 0; + for j,vj in v do + begin + if vj[0]bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then + begin + flg := true; + break; + end + //zz:=vj[2]; + zoom_to_xyz(vj[0],vj[1],vj[2],_x,_y,_z); + zz := vj[2]; + ps[j] := array(_x,_y); + end + if flg then continue; + if zz>0 then cvs.brush.color := 0x00ff00; + else + cvs.brush.color := 0xff0000; + dp.points(ps).requiregdi().draw(); + end + cvs.axesunclip(); + end +end +//////////////////饼图范例/////////////////////////////////////////// +uses tslvcl,utvclgraphics; +app := initializeapplication(); +app.createform(class(tfm),fm); +fm.show(); +app.run(); +type tfm = class(tvcform) + function create(aowner); + begin + inherited; + caption := "pie"; + fg := new tg_WinControl(self); + fg.Caption := "hello1"; + fg.parent := self; + fg.Align := alClient; + //////////设置坐标轴属性//////////////////////// + axs := new tg_axes(); + axs.figure := fg.figure; + axs.title.text := "hello pie "; + axs.axises(1).tics_color := 0x0000ff; + axs.axises(1).fontinfo.size := 8; + axs.data_bounds(0) := array(-0.1,2.1); + axs.data_bounds(1) := array(-0.1,2.1); + args := array( + (pi()/4,pi()/3,0x0000ff), + (pi()/3,pi()/2,0x00ff00), + (pi()/2,pi()*3/2,0xff0000), + (pi()*3/2,pi()*9/4,0xff00ff) + + ); + for i,v in args do + begin + line := new tg_Polyline(); + line.polyline_style := line.tgc_LS_filled; + line.closed := true; + line.graph_data := 1+get_pie_lines(v[0],v[1]); + line.lineinfo.bkcolor := v[2]; + line.parent := axs; + end + end + function get_pie_lines(arg1,arg2); + begin + stp := pi()/180; + d := 1; + r := array((0,0)); + idx := 1; + for i:= arg1 to arg2 step stp do + begin + r[idx++] := array(sin(i),cos(i)); + + end + r[length(r)] :=array(0,0); + return r; + end + fg; +end } - type tg_WinControl = class(tcustomcontrol,tg_const) //绘图窗口 function create(AOwner); begin @@ -334,21 +520,14 @@ type tg_axes = class(tg_base) // p_left; p_top; p_width; - p_height; - dx_min; - dx_max; - dx_len; - dy_min; - dy_max; - dy_len; - rt_x; - rt_y; - f_changed; - static const c_g_paint_rect=2; + p_height; + f_changed; static const c_g_data_changed=1; + static const c_g_paint_rect=2; static const c_g_data_zoombox=4; + static const c_g_rote_changed=8; /////////////////////////////////////////// - public + public //zoom-xyz function executecommand(cmd,pm);override; begin ochanged := f_changed; @@ -358,7 +537,7 @@ type tg_axes = class(tg_base) // if not ifarray(pm) then return ; p0 := pm["x"]; p1 := pm["y"]; - for i := 0 to 1 do + for i := 0 to 2 do begin a0 := fzoom_box[i,0]; b0 := fzoom_box[i,1]; @@ -366,9 +545,9 @@ type tg_axes = class(tg_base) // begin continue; end - if not Coordinate_unMapping(p0,p1,x,y,z) then continue ; + if not xyz_to_zoom(p0,p1,fzoom_box[2,0],x,y,z) then continue ; dx := ((pm["delta"]>0)?(1.05):(1/1.05)); - if not zoom_bound_op(a0,b0,dx,array(x,y)[i],a,b) then continue ; + if not zoom_bound_op(a0,b0,dx,array(x,y,z)[i],a,b) then continue ; rt := 1; cg := 0; if af_changed then prop_changed("data_changed",f_changed); end - function Coordinate_unMapping(x,y,_x,_y,_z);override; //画布到坐标 - begin - if not(fFigure) then return 0; - if faxes_reverse[0]=tgc_on then //x轴 - begin - _x := fzoom_box[0,0]-(x-p_left-p_width)/rt_x; - end else - begin - _x := (x-p_left)/rt_x+fzoom_box[0,0]; - end - if faxes_reverse[1]=tgc_on then //y轴 - begin - _y := (y-p_top)/rt_y +fzoom_box[1,0]; - end else - begin - _y := fzoom_box[1,0]-(y-p_top-p_height)/rt_y; - end - return true; - end + function axes_mapping(x,y,z,_x,_y);override;//坐标系相对位置到画布 begin if not(fFigure ) then return false; @@ -440,30 +601,61 @@ type tg_axes = class(tg_base) // _y := (y-p_top)/p_height; return true; end - function Coordinate_Mapping(x,y,z,_x,_y);override; //坐标到画布 + function zoom_to_xyz(x,y,z,_x,_y,_z); //---------- begin - if not(fFigure) then return 0; - if faxes_reverse[0]=tgc_on then //x轴 - begin - _x := p_left+p_width-(x-fzoom_box[0,0])*rt_x; - end else - begin - _x := (x-fzoom_box[0,0])*rt_x+p_left; - end - if faxes_reverse[1]=tgc_on then //y轴 - begin - _y := (y-fzoom_box[1,0])*rt_y+p_top; - end else - begin - _y := p_top+p_height-(y-fzoom_box[1,0])*rt_y; - end + if not(fFigure ) then return false; + if faxes_reverse[0]=tgc_on then x0 := fcoordinate_sizes[0]/2-(x-fzoom_bounds[0,0])/fzoom_coordinate_rates[0]; + else + x0 := (x-fzoom_bounds[0,0])/fzoom_coordinate_rates[0] -fcoordinate_sizes[0]/2; + if faxes_reverse[1]=tgc_on then y0 := fcoordinate_sizes[1]/2-(y-fzoom_bounds[1,0])/fzoom_coordinate_rates[1]; + else y0 := (y-fzoom_bounds[1,0])/fzoom_coordinate_rates[1] -fcoordinate_sizes[1]/2; + if faxes_reverse[2]=tgc_on then z0 := fcoordinate_sizes[2]/2-(z-fzoom_bounds[2,0])/fzoom_coordinate_rates[2]; + else z0 := (z-fzoom_bounds[2,0])/fzoom_coordinate_rates[2] -fcoordinate_sizes[2]/2; + transxyz(x0,y0,z0,_x,_y,_z); + _x +=fbounds_center[0]; + _y +=fbounds_center[1]; + _z +=fbounds_center[2]; return true; end + function xyz_to_zoom(x,y,z,_x,_y,_z); + begin + if not(fFigure ) then return false; + x1 := x;y1 := y;z1 := z; + x1 -=fbounds_center[0]; + y1 -=fbounds_center[1]; + z1 -=fbounds_center[2]; + untransxyz(x1,y1,z1,x0,y0,z0); + if faxes_reverse[0]=tgc_on then + begin + _x := (fcoordinate_sizes[0]/2-x0)*fzoom_coordinate_rates[0]+fzoom_bounds[0,0]; + end + else + begin + _x := (x0+fcoordinate_sizes[0]/2)*fzoom_coordinate_rates[0]+fzoom_bounds[0,0]; + end + if faxes_reverse[1]=tgc_on then + begin + _y := (fcoordinate_sizes[1]/2-y0)*fzoom_coordinate_rates[1]+fzoom_bounds[1,0]; + end + else + begin + _y := (y0+fcoordinate_sizes[1]/2)*fzoom_coordinate_rates[1]+fzoom_bounds[1,0]; + end + if faxes_reverse[2]=tgc_on then + begin + _z := (fcoordinate_sizes[2]/2-z0)*fzoom_coordinate_rates[2]+fzoom_bounds[2,0]; + end + else + begin + _z := (z0+fcoordinate_sizes[2]/2)*fzoom_coordinate_rates[2]+fzoom_bounds[2,0]; + end + return true; + end function paint_pre(cvs); begin - if not visible then return ; + if visible<>tgc_on then return ; axes_changed(); - modify_coordinate_postion(); + modify_coordinate_position(); r := array(p_left-1,p_top-1,p_left+p_width+1,p_top+p_height+1); cvs.axesrec := r; paint(cvs); @@ -479,18 +671,11 @@ type tg_axes = class(tg_base) // v.paint(cvs); end modify_label_postion(); - for i,v in array(ftitle,fx_label,fy_label) do //标签 - begin - v.paint(cvs); - end + ftitle.paint(cvs); if fbox = tgc_on then begin set_lineinfo_to_canvas(cvs); - cvs.moveto(array(p_left,p_top)); - cvs.lineto(array(p_left+p_width,p_top)); - cvs.lineto(array(p_left+p_width,p_top+p_height)); - cvs.lineto(array(p_left,p_top+p_height)); - cvs.lineto(array(p_left,p_top)); + paint_box(cvs); end end function axes_changed();//改变 @@ -498,13 +683,16 @@ type tg_axes = class(tg_base) // if not fFigure then return ; if f_changed then begin + change_locked := true; fr := fFigure.rect(); w := fr[2]-fr[0]; h := fr[3]-fr[1]; + p_left := fr[0]+w*fmargins[0]+faxes_bounds[0]; p_top := fr[1]+h*fmargins[1]+faxes_bounds[1]; p_width := w*(1-fmargins[0]-fmargins[2])*faxes_bounds[2]; - p_height := h*(1-fmargins[1]-fmargins[3])*faxes_bounds[3]; + p_height := h*(1-fmargins[1]-fmargins[3])*faxes_bounds[3]; + fcvs_bounds := array(p_left,p_top,p_left+p_width,p_top+p_height); if (f_changed .& c_g_data_changed)=c_g_data_changed then begin tbds := fdata_bounds; @@ -518,28 +706,99 @@ type tg_axes = class(tg_base) // end fdata_bounds := tbds; fzoom_box := tbds; + fzoom_bounds := fzoom_box; end + /////////////计算旋转矩阵////////////////////////// + if (f_changed .& c_g_rote_changed)=c_g_rote_changed then + begin + c := cos(falpha); + s := sin(falpha); + c1 := cos(ftheta); + s1 := sin(ftheta); + frote_mt := array((0,1,0),(1,0,0),(0,0,1)):*array((c,s,0),(-s,c,0),(0,0,1)):*array((1,0,0),(0,c1,s1),(0,-s1,c1)); + end + //////////////////////////////////////// if (f_changed .& c_g_data_zoombox)=c_g_data_zoombox then begin - auto_set_axis(); - end - dx_min := fzoom_box[0,0]; - dx_max := fzoom_box[0,1]; - dx_len := dx_max-dx_min; - dy_min := fzoom_box[1,0]; - dy_max := fzoom_box[1,1]; - dy_len := dy_max-dy_min; - rt_x := p_width/ dx_len; - rt_y := p_height/dy_len; - end - f_changed := 0; + fzoom_bounds := fzoom_box; + end + recalc_size(); + auto_set_axis(); + change_locked := false; + end + f_changed := 0; end - + private + //////////长宽高//////////////////// + fbounds_center; //中心 + ////////////////////// + fface_v_indexs; //定点次序 + flines_index;// + ftheta; + ftheta_a; + falpha; + falpha_a; + frote_mt; + fcvs_bounds; + fzoom_bounds; + fbox_vertexs; + fzoom_coordinate_rates; + fcoordinate_sizes; + frevers; + public //create + function set_trans(t,a); //设置转换角度 + begin + if (t=ftheta) and (falpha=a) then return ; + if ifnumber(t) then + begin + ftheta_a := (r_2_a(t) mod 360); + ftheta := a_2_r(ftheta_a); + end + if ifnumber(a) then + begin + falpha_a := r_2_a(a) mod 360; + falpha := a_2_r(falpha_a); + end + if ifnumber(t) or ifnumber(a) then f_changed .|=8; + prop_changed(); + return ; + end function create(pms); begin inherited; - fdata_bounds_locked := array(0,0,0); f_changed := 0; + ftheta := 0; + falpha := 0; + flines_index := array( + (0,1), + (1,2), + (2,3), + (3,0), + (4,5), + (5,6), + (6,7), + (7,4), + (0,4), + (1,5), + (2,6), + (3,7) + ); + fface_v_indexs := array( + (0,1,2,3), + (0,4,7,3), + (0,1,5,4), + (1,5,6,2), + (2,6,7,3), + (4,5,6,7) + ); + fcvs_bounds := array(0,0,200,200); + fcoordinate_sizes := array(200,200,200); + frote_mt := array((0,1,0),(1,0,0),(0,0,1)); + fbounds_center := array(100,100,100); + fzoom_bounds := array((0,200),(0,200),(0,200)); + set_trans(0,pi()*1.5); + fzoom_coordinate_rates := array(1,1,1); + fdata_bounds_locked := array(0,0,0); fgrid := array(); for i:= 0 to 1 do begin @@ -548,35 +807,50 @@ type tg_axes = class(tg_base) // gd.Style := tgc_PS_DOT; fgrid[i] := gd; end + faxes_reverse := array(tgc_off,tgc_off,tgc_off); - fview := "2d"; fbox := tgc_off; ffilled := tgc_off; fx_location := tgc_bottom; + fz_location := tgc_right; fy_location := tgc_left; faxes_objects := array(); for i := 0 to 2 do begin axi := new tg_axis_main(); axi.tics_style := tgc_tics_v;//tgc_tics_r; + lbl := new tg_label_axis(); case i of - 0: axi.tics_direction := tgc_bottom; - 1:axi.tics_direction := tgc_left; - 2:axi.visible := false; + 0: + begin + fx_label := lbl; + axi.tics_direction := tgc_bottom; + axi.ytics_coord := array("x",0,0); + axi.tag := "+x+"; + end + 1: + begin + fy_label := lbl; + axi.tics_direction := tgc_left; + axi.ytics_coord := array(0,"y",0); + axi.tag := "+y+"; + end + 2: + begin + fz_label := lbl; + //axi.visible := false; + axi.ytics_coord := array(0,0,"z"); + axi.tag := "+z+"; + end end ; + axi.axis_label := lbl; faxes_objects[i] := axi; axi.axes := self(true); end ftitle := new tg_label_axes(); - ftitle.axes := self(true); - fx_label := new tg_label_axes(); - fx_label.axes := self(true); - fy_label := new tg_label_axes(); - fy_label.axes := self(true); - fy_label.font_angle := pi()/2; - - + ftitle.axes := self(true); + ftitle.location := tgc_by_axes; fauto_ticks := array(tgc_on,tgc_on,tgc_on); fmargins := array(0.125,0.125,0.125,0.125); faxes_bounds := array( 0,0,1,1); @@ -590,11 +864,11 @@ type tg_axes = class(tg_base) // end published property figure read fFigure write SetFigure; //窗口 - property view read fview write set_view; //立体 property axises read get_axises;//axes_visible ;//= ["on","on","on"] property axes_reverse read gs_axes_reverse write gs_axes_reverse;//axes_reverse ;//= ["off","off","off"] property x_location read fx_location write set_x_location;//'bottom property y_location read fy_location write set_y_location;//'left + property z_location read fz_location write set_z_location;//'left property title read ftitle; property x_label read fx_label; property y_label read fy_label; @@ -664,7 +938,7 @@ type tg_axes = class(tg_base) // begin return self(true); end - private + private //variable fgrid; faxes_objects; fzoom_box; @@ -680,7 +954,7 @@ type tg_axes = class(tg_base) // fz_label; fx_location; fy_location; - fview; + fz_location; fbox; faxes_reverse; private @@ -692,60 +966,94 @@ type tg_axes = class(tg_base) // if xg.width>0 and ifnumber(xg.color) then begin set_lineinfo_to_canvas(cvs,xg); - y1 := p_top; - y2 := p_top+p_height; + //y1 := p_top; + //y2 := p_top+p_height; for i,v in faxes_objects[0].executecommand("get_tics_value") do begin if vfzoom_box[0,1] then continue; - if Coordinate_Mapping(v,0,0,_x,_y) then + if zoom_to_xyz(v,fzoom_box[1,0],0,_x1,_y1) then begin - cvs.moveto(array(_x,y1)); - cvs.lineto(array(_x,y2)); - end + zoom_to_xyz(v,fzoom_box[1,1],0,_x2,_y2); + cvs.moveto(array(_x1,_y1)); + cvs.lineto(array(_x2,_y2)); + end end end xg := fgrid[1]; if xg.width>0 and ifnumber(xg.color) then begin set_lineinfo_to_canvas(cvs,xg); - x1 := p_left; - x2 := p_left+p_width; for i,v in faxes_objects[1].executecommand("get_tics_value") do begin if vfzoom_box[1,1] then continue; - if Coordinate_Mapping(0,v,0,_x,_y) then + if zoom_to_xyz(fzoom_box[0,0],v,0,_x1,_y1) then begin - cvs.moveto(array(x1,_y)); - cvs.lineto(array(x2,_y)); - end + zoom_to_xyz(fzoom_box[0,1],v,0,_x2,_y2); + cvs.moveto(array(_x1,_y1)); + cvs.lineto(array(_x2,_y2)); + end end end end + function paint_box(cvs); + begin + r := array(); + ls := array(); + ps2 := array(); + inpoints := array(); + tf := get_top_face(); //获得顶部的3个面 + for i,fc in tf do + begin + for ii in fbox_vertexs do //判断点是否在面的阴影中 + begin + if (ii in fc) then continue; + if point_in_rgn(fbox_vertexs[fc],fbox_vertexs[ii]) then + begin + inpoints[length(inpoints)] := ii; + end + end + end + hd := array(); + for i,v in flines_index do //判断线是否需要隐藏 + begin + ps := fbox_vertexs[v]; + if (inpoints intersect v) then hd[i] := true; + for j,vj in ps do + ls[i,j] := vj[0:1]+fbounds_center; + end + for i,v in ls do //绘制线 + begin + ps1 := v; + if hd[i] then cvs.pen.style := 1; + else cvs.pen.style := 0; + cvs.draw_polyline().points(ps1).draw(); + end + end function auto_set_axis();//自动计算坐标 begin - sz := array(p_width,p_height); - for i:=0 to 1 do + for i:=0 to 2 do begin axi :=faxes_objects[i]; axi.executecommand("set_bounds",fzoom_box[i]); + if axi.visible<>tgc_on then continue; fsz := axi.fontinfo.size; if fauto_ticks[i] = tgc_on then begin - if i=0 then + [arg,ifx,sz] := axi.executecommand("get_angleofhoriz"); + if ifx then begin - n := integer(sz[0]/(fsz*15)); + n := integer(sz/(fsz*12)); end else - if i=1 then begin - n := integer(sz[1]/(fsz*6)); - end + n := integer(sz/(fsz*4)); + end xcd := array(); xcdls := array(); if n>0 then begin rt := new_bounds(fzoom_box[i,0],fzoom_box[i,1],a_,b_); bs :=ceil((b_-a_)/(rt)/n); - axi.sub_tics := bs; + axi.sub_tics := min(bs,5); stp := bs*rt; vi := a_; ii := 0; @@ -755,7 +1063,7 @@ type tg_axes = class(tg_base) // vi+=stp; end end - axi.xtics_coord := xcd; + axi.tics_coord := xcd; end end end @@ -779,118 +1087,294 @@ type tg_axes = class(tg_base) // end function modify_label_postion(); //修正标签位置 begin - if fx_label and (fx_label.visible=tgc_on) and (fx_label.auto_position=tgc_on) then - begin - s := fx_label.text; - if s then - begin - x := p_left+(p_width-length(s)*10)/2; - ax := faxes_objects[0]; - y := p_top+p_height+20; - if ax.visible=tgc_on and ax.tics_direction = tgc_bottom then - begin - y +=ax.fontinfo.size*2; - end - if fx_label.location=tgc_by_coordinates then - Coordinate_unMapping(x,y,_x,_y,_z); - else axes_unmapping(x,y,_x,_y,_z); - p := array(_x,_y); - fx_label.executecommand("auto_position_value",p); - end - end - if fy_label and (fy_label.visible=tgc_on) and (fy_label.auto_position=tgc_on) then - begin - s := fy_label.text; - fsz := fy_label.fontinfo.size; - if s then - begin - y := p_top+(p_height-length(s)*fsz)/2; - if (fy_location= tgc_left) then - begin - x := p_left+p_width+5+fsz*2; - end - else - begin - x := p_left-5;//-fy_label.fontinfo.size; - end - if fy_label.location=tgc_by_coordinates then - - Coordinate_unMapping(x,y,_x,_y,_z); - else axes_unmapping(x,y,_x,_y,_z); - p := array(_x,_y); - fy_label.executecommand("auto_position_value",p); - end - end if ftitle and (ftitle.visible=tgc_on) and (ftitle.auto_position=tgc_on) then begin s := ftitle.text; if s then begin ax := faxes_objects[0]; - y := p_top-20-(ftitle.fontinfo.size*2); - if (ax.visible=tgc_on) and (ax.tics_direction = tgc_top) then + //y := p_top-20-(ftitle.fontinfo.size*2); + fr := fFigure.rect(); + y := fr[1]+10; + {if (ax.visible=tgc_on) and (ax.tics_direction = tgc_top) then begin y -=(ax.fontinfo.size*2); - end + end} x := p_left+(p_width-length(s)*10)/2; if ftitle.location=tgc_by_coordinates then - Coordinate_unMapping(x,y,_x,_y,_z); + xyz_to_zoom(x,y,0,_x,_y,_z); else axes_unmapping(x,y,_x,_y,_z); ftitle.executecommand("auto_position_value",array(_x,_y)); end end end - function modify_coordinate_postion();//修正坐标轴位置 + function get_axis_index(p); begin - axy := faxes_objects[1]; - case fy_location of - tgc_left: - begin - axy.ytics_coord := fzoom_box[0,(faxes_reverse[0] = tgc_on)]; - end - tgc_right: - begin - axy.ytics_coord := fzoom_box[0,(faxes_reverse[0]<> tgc_on)]; - - end - tgc_middle: - begin - axy.ytics_coord := fzoom_box[0,0]+(fzoom_box[0,1]-fzoom_box[0,0])/2; - end - tgc_origin: - begin - if fzoom_box[0,0]<0 and fzoom_box[0,1]>0 then - axy.ytics_coord := 0; - else - begin - axy.ytics_coord := fzoom_box[0,(faxes_reverse[0] = tgc_on)]; - end - end - end ; + r := array(); + for i,v in p do + begin + zoom_to_xyz(v[0],v[1],v[2],_x0,_y0,_z0); + r[i] := array(_x0,_y0,_z0); + end + return sselect thisrowindex from r order by [1] asc end; + end + function get_duan_dian(x0,y0,z0,x1,y1,z1,x2,y2,z2); + begin + x0 := fzoom_box[0,0]; + y0 := fzoom_box[1,0]; + z0 := fzoom_box[2,0]; + x1 := fzoom_box[0,1]; + y1 := fzoom_box[1,1]; + z1 := fzoom_box[2,1]; + x2 := (x0+x1)/2; + y2 := (y0+y1)/2; + z2 := (z0+z1)/2; + end + + function modify_x_position(loc); + begin + get_duan_dian(x0,y0,z0,x1,y1,z1,x2,y2,z2); + //////bottom + px := array(); + px[0] := array(x2,y0,z0); + px[1] := array(x2,y0,z1); + ///top + px[2] := array(x2,y1,z0); + px[3] := array(x2,y1,z1); + r := array(); + for i,v in px do + begin + zoom_to_xyz(v[0],v[1],v[2],_x0,_y0,_z0); + r[i] := array(_x0,_y0,_z0); + end axx := faxes_objects[0]; - case fx_location of + case loc of tgc_bottom: - begin - axx.ytics_coord := fzoom_box[1,(faxes_reverse[1]= tgc_on)]; + begin + if like_0(ftheta) then + begin + if faxes_reverse[1]=tgc_on then idx := 2; + else + idx := 0; + end else + begin + idxs := sselect thisrowindex from r order by [1] asc end; + if faxes_reverse[1]=tgc_on then idx := idxs[3]; + else + idx := idxs[0]; + end + idxv := px[idx]; + zoom_to_xyz(x2,y2,z2,_x0,_y0,_z0);//中间点 + zoom_to_xyz(x0,idxv[1],idxv[2],_x00,_y00,_z00);//轴线0点 + v1 := array(_x0-r[idx,0],_y0-r[idx,1]);//射线方向 + v2 := array(r[idx,0]-_x00,r[idx,1]-_y00); //轴方向 + p_trans(v2[0],v2[1],-pi()/2.01,_x,_y); + jj := r_2_a( d2angle(array(_x,_y),v1)); + axx.ytics_coord := array("x",idxv[1],idxv[2]); + if jj>90 then axx.tics_direction := tgc_direct_desc ; + else axx.tics_direction := tgc_direct_asc; + return ; + axx.ytics_coord := array("x",fzoom_box[1,(faxes_reverse[1]= tgc_on)],fzoom_box[2,(faxes_reverse[1]= tgc_on)]); + if faxes_reverse[0]=tgc_on then axx.tics_direction := tgc_direct_asc; + else + axx.tics_direction := tgc_direct_desc; end tgc_top: begin - axx.ytics_coord := fzoom_box[1,(faxes_reverse[1]<> tgc_on)]; + if like_0(ftheta) then + begin + if faxes_reverse[1]=tgc_on then idx := 0; + else + idx := 2; + end else + begin + idxs := sselect thisrowindex from r order by [1] desc end; + if faxes_reverse[1]=tgc_on then idx := idxs[3]; + else + idx := idxs[0]; + end + idxv := px[idx]; + zoom_to_xyz(x2,y2,z2,_x0,_y0,_z0);//中间点 + zoom_to_xyz(x0,idxv[1],idxv[2],_x00,_y00,_z00);//轴线0点 + v1 := array(_x0-r[idx,0],_y0-r[idx,1]);//射线方向 + v2 := array(r[idx,0]-_x00,r[idx,1]-_y00); //轴方向 + p_trans(v2[0],v2[1],-pi()/2.01,_x,_y); + jj := r_2_a( d2angle(array(_x,_y),v1)); + axx.ytics_coord := array("x",idxv[1],idxv[2]); + if jj>90 then axx.tics_direction := tgc_direct_desc ; + else axx.tics_direction := tgc_direct_asc; + return ; + axx.ytics_coord := array("x",fzoom_box[1,(faxes_reverse[1]<> tgc_on)],fzoom_box[2,(faxes_reverse[1]= tgc_on)]); + if faxes_reverse[0]=tgc_on then axx.tics_direction := tgc_direct_desc; + else + axx.tics_direction := tgc_direct_asc; end tgc_middle: begin - axx.ytics_coord := fzoom_box[1,0]+(fzoom_box[1,1]-fzoom_box[1,0])/2; + axx.ytics_coord := array("x",fzoom_box[1,0]+(fzoom_box[1,1]-fzoom_box[1,0])/2,0); end tgc_origin: begin if fzoom_box[1,0]<0 and fzoom_box[1,1]>0 then - axx.ytics_coord := 0; + axx.ytics_coord := array("x",0,0); else begin - axx.ytics_coord := fzoom_box[1,(faxes_reverse[1]= tgc_on)]; + return modify_x_position(tgc_bottom); + //axx.ytics_coord := array("x",fzoom_box[1,(faxes_reverse[1]= tgc_on)],0); end + axx.tics_direction := tgc_direct_desc; end - end ; + end ; + end + function modify_y_postion(loc); + begin + get_duan_dian(x0,y0,z0,x1,y1,z1,x2,y2,z2); + //////left + py := array(); + py[0] := array(x0,y2,z0); + py[1] := array(x0,y2,z1); + ///right + py[2] := array(x1,y2,z0); + py[3] := array(x1,y2,z1); + r := array(); + for i,v in py do + begin + zoom_to_xyz(v[0],v[1],v[2],_x0,_y0,_z0); + r[i] := array(_x0,_y0,_z0); + end + axy := faxes_objects[1]; + case loc of + tgc_left: + begin + if like_0(ftheta) then + begin + if faxes_reverse[0]=tgc_on then idx := 2; + else + idx := 0; + end else + begin + idxs := sselect thisrowindex from r order by [1] desc end; + if faxes_reverse[0]=tgc_on then idx := idxs[3]; + else + idx := idxs[0]; + end + idxv := py[idx]; + zoom_to_xyz(x2,y2,z2,_x0,_y0,_z0);//中间点 + zoom_to_xyz(idxv[0],y0,idxv[2],_x00,_y00,_z00);//轴线0点 + v1 := array(_x0-r[idx,0],_y0-r[idx,1]);//射线方向 + v2 := array(r[idx,0]-_x00,r[idx,1]-_y00); //轴方向 + p_trans(v2[0],v2[1],-pi()/2.01,_x,_y); + jj := r_2_a( d2angle(array(_x,_y),v1)); + axy.ytics_coord := array(py[idx,0],"y",py[idx,2]); + if jj>90 then axy.tics_direction := tgc_direct_desc ; + else axy.tics_direction := tgc_direct_asc; + return ; + axy.ytics_coord := array(fzoom_box[0,(faxes_reverse[0] = tgc_on)],"y",fzoom_box[2,(faxes_reverse[1]= tgc_on)]); + if faxes_reverse[1]=tgc_on then axy.tics_direction := tgc_direct_desc ; + else + axy.tics_direction := tgc_direct_asc; + end + tgc_right: + begin + if like_0(ftheta) then + begin + if faxes_reverse[0]=tgc_on then idx := 0; + else + idx := 2; + end else + begin + idxs := sselect thisrowindex from r order by [1] asc end; + if faxes_reverse[0]=tgc_on then idx := idxs[3]; + else + idx := idxs[0]; + end + idxv := py[idx]; + zoom_to_xyz(x2,y2,z2,_x0,_y0,_z0);//中间点 + zoom_to_xyz(idxv[0],y0,idxv[2],_x00,_y00,_z00);//轴线0点 + v1 := array(_x0-r[idx,0],_y0-r[idx,1]);//射线方向 + v2 := array(r[idx,0]-_x00,r[idx,1]-_y00); //轴方向 + p_trans(v2[0],v2[1],-pi()/2.01,_x,_y); + jj := r_2_a( d2angle(array(_x,_y),v1)); + axy.ytics_coord := array(py[idx,0],"y",py[idx,2]); + if jj>90 then axy.tics_direction := tgc_direct_desc ; + else axy.tics_direction := tgc_direct_asc; + return ; + axy.ytics_coord := array(fzoom_box[0,(faxes_reverse[0]<> tgc_on)],"y",fzoom_box[2,(faxes_reverse[1]= tgc_on)]); + if faxes_reverse[1]=tgc_on then axy.tics_direction := tgc_direct_asc; + else + axy.tics_direction := tgc_direct_desc; + end + tgc_middle: + begin + axy.ytics_coord := array(fzoom_box[0,0]+(fzoom_box[0,1]-fzoom_box[0,0])/2,"y",0); + end + tgc_origin: + begin + if fzoom_box[0,0]<0 and fzoom_box[0,1]>0 then + begin + axy.ytics_coord := array(0,"y",0); + end + else + begin + return modify_y_postion(tgc_left); + //axy.ytics_coord := array(fzoom_box[0,(faxes_reverse[0] = tgc_on)],"y",0); + end + axy.tics_direction := tgc_direct_asc; + end + end; + end + function modify_z_position(loc); + begin + if like_0(ftheta_a) then return ; + get_duan_dian(x0,y0,z0,x1,y1,z1,x2,y2,z2); + axz := faxes_objects[2]; + pz := array(); + pz[0] := array(x0,y0,z2); + pz[1] := array(x1,y0,z2); + pz[2] := array(x1,y1,z2); + pz[3] := array(x0,y1,z2); + r := array(); + for i,v in pz do + begin + zoom_to_xyz(v[0],v[1],v[2],_x0,_y0,_z0); + r[i] := array(_x0,_y0,_z0); + end + case loc of + tgc_right: + begin + idxs := sselect thisrowindex from r order by [0] desc end; + end + else + begin + idxs := sselect thisrowindex from r order by [0] asc end; + end + end; + idx := idxs[0]; + idxv := pz[idx]; + zoom_to_xyz(x2,y2,z2,_x0,_y0,_z0);//中间点 + zoom_to_xyz(idxv[0],idxv[1],z0,_x00,_y00,_z00);//轴线0点 + v1 := array(_x0-r[idx,0],_y0-r[idx,1]);//射线方向 + v2 := array(r[idx,0]-_x00,r[idx,1]-_y00); //轴方向 + p_trans(v2[0],v2[1],-pi()/2.01,_x,_y); + jj := r_2_a( d2angle(array(_x,_y),v1)); + axz.ytics_coord := array(pz[idx,0],pz[idx,1],"z"); + if jj>90 then axz.tics_direction := tgc_direct_desc ; + else axz.tics_direction := tgc_direct_asc; + return ; + + axz.ytics_coord := array(idxv[0],idxv[1],"z"); + if ftheta_a>180 or ftheta_a<0 then axz.tics_direction :=tgc_direct_asc ; + else axz.tics_direction := tgc_direct_desc ; + end + function modify_coordinate_position();//修正坐标轴位置 + begin + + ////////////////y轴/////////////////////////////////// + modify_y_postion(fy_location); + ///////////////x/////////////////////////////// + modify_x_position(fx_location); + //////z-axis + modify_z_position(fz_location); end function SetFigure(v); //添加窗口 begin @@ -938,9 +1422,13 @@ type tg_axes = class(tg_base) // end function set_box(v); begin - if (v in array(tgc_box_on,tgc_box_off,tgc_box_half,tgc_box_hidden_axes)) and v<>fbox then + if not tg_boolen_value(v,nv) then + begin + nv := v; + end + if (nv in array(tgc_box_on,tgc_box_off,tgc_box_half,tgc_box_hidden_axes)) and v<>fbox then begin - fbox := v; + fbox := nv; prop_changed("box",v); end end @@ -949,7 +1437,6 @@ type tg_axes = class(tg_base) // if v<>fx_location and ( v in array(tgc_bottom,tgc_top,tgc_middle,tgc_origin)) then begin fx_location := v; - if v=tgc_bottom or v=tgc_top then faxes_objects[0].tics_direction := v; prop_changed("x_location",v); end end @@ -958,10 +1445,17 @@ type tg_axes = class(tg_base) // if v<>fy_location and ( v in array(tgc_left,tgc_right,tgc_middle,tgc_origin)) then begin fy_location := v; - if v=tgc_left or v=tgc_right then faxes_objects[1].tics_direction := v; prop_changed("y_location",v); end end + function set_z_location(v); + begin + if v<>fz_location and ( v in array(tgc_left,tgc_right)) then + begin + fz_location := v; + prop_changed("z_location",v); + end + end function get_grid(idx); begin if idx=0 or idx=1 then return fgrid[idx]; @@ -993,7 +1487,7 @@ type tg_axes = class(tg_base) // end function get_axises(idx); begin - if idx in array(0,1) then + if idx in array(0,1,2) then begin return faxes_objects[idx]; end @@ -1054,16 +1548,17 @@ type tg_axes = class(tg_base) // end function gs_axes_reverse(idx,v); //反向 begin - if v=tgc_off or v=tgc_on then + if not tg_boolen_value(v,nv) then return ; + if nv=tgc_off or nv=tgc_on then begin - if idx in array(0,1,2) then + if idx in array(0,1) then begin - faxes_reverse[idx] := v; + faxes_reverse[idx] := nv; prop_changed("axes_reverse",idx); end end else //get begin - if idx in array(0,1,2) then return faxes_reverse[idx]; + if idx in array(0,1) then return faxes_reverse[idx]; return faxes_reverse; end end @@ -1097,6 +1592,140 @@ type tg_axes = class(tg_base) // return array(faxes_objects[0].sub_tics,faxes_objects[1].sub_tics,faxes_objects[2].sub_tics); end end + + ////////////////三维转换//////////////////// + function transxyz(x,y,z,_x,_y,_z); //旋转数据 + begin + r := array((x,y,z)):*frote_mt; + _x := r[0,0]; + _y := r[0,1]; + _z := r[0,2]; + end + function untransxyz(x,y,z,_x,_y,_z); + begin + r := array((x,y,z)):/frote_mt; + _x := r[0,0]; + _y := r[0,1]; + _z := r[0,2]; + end + function get_new_w_h(w1,h1,w,h,z);//获取变换的大小 + begin + //z1 := (w1+h1)/2; + z1 := min(w1,h1); + z := z1; + w := w1; + h := h1; + while true do + begin + ps := init_vecs(h,w,z); + bd := zeros(2,2); + for i,v in ps do + begin + transxyz(v[0],v[1],v[2],_x,_y,_z); + bd[0,0] := min(_x,bd[0,0]); + bd[0,1] := max(_x,bd[0,1]); + bd[1,0] := min(_y,bd[1,0]); + bd[1,1] := max(_y,bd[1,1]); + end + bw := bd[0,1]-bd[0,0]; + bh := bd[1,1]-bd[1,0]; + if bwffont_angle and ifnumber(v) then + begin + ffont_angle := v; + prop_changed("font_angle",v); + end + end + function set_text(v); + begin + if v<>ftext and ifstring(v) then + begin + ftext := v; + prop_changed("text",v); + end + end +end type tg_label_axes = class(tg_label) //坐标系标签 public function create(pms); @@ -1187,13 +1875,13 @@ type tg_axis = class(tg_base) // clip_state := tgc_off; fticksize := 12; fsubticksize := 6; - ftics_direction := tgc_bottom; // + ftics_direction := tgc_direct_asc; // fxtics_coord := array(0,1,2,3); ftcmin := 0; ftcmax := 3; ftccount := 3; fxtics_coord_v := array(0,1,2,3); - fytics_coord := 0; + fytics_coord := array("tics",0,0); ftics_labels := array("0","1","2","3"); ftics_segment := tgc_on; ftics_style := tgc_tics_v;//"v"; @@ -1207,7 +1895,12 @@ type tg_axis = class(tg_base) // begin case cmd of "get_tics_value":return fxtics_coord_v; - "set_bounds": return set_zoom_bounds(pm); + "set_bounds": return set_zoom_bounds(pm); + "get_angleofhoriz" : + begin + get_angleofhoriz(xarg,ifh,sz); + return array(xarg,ifh,sz); + end end; end function paint(cvs);override; @@ -1229,25 +1922,8 @@ type tg_axis = class(tg_base) // subtks[idx++] := vi; end end - end - case ftics_direction of - tgc_top: - begin - draw_axis(cvs,subtks,1); - end - tgc_bottom: - begin - draw_axis(cvs,subtks,1+2); - end - tgc_left: - begin - draw_axis(cvs,subtks,0); - end - tgc_right: - begin - draw_axis(cvs,subtks,0+2); - end - end + end + return draw_axis(cvs,subtks); end protected function draw_tics(cvs,info);virtual; @@ -1264,14 +1940,15 @@ type tg_axis = class(tg_base) // published ///////////////////////////////////// property tics_direction read ftics_direction write set_tics_direction;//= "top" - property xtics_coord read fxtics_coord write set_xtics_coord ;//= [2,3,4,5,6,7] + property tics_coord read fxtics_coord write set_xtics_coord ;//= [2,3,4,5,6,7] property ytics_coord read fytics_coord write set_ytics_coord ;//= 4 property tics_segment read ftics_segment write set_tics_segment; // true,false property tics_color read ftics_color write set_tics_color; // -1 property tics_style read ftics_style write set_tics_style; // = "v" property sub_tics read fsub_tics write set_sub_tics; // = 2 property tics_labels read ftics_labels write set_tics_labels; // = ["2","3","4","5","6","7"] - private + property axis_label read flabel write flabel; + private fzoom_bounds; fticksize; fsubticksize; @@ -1288,6 +1965,7 @@ type tg_axis = class(tg_base) // ftics_segment; ftics_style; ftics_labels; + flabel; //format_n ;//= "" //fractional_font ;//= "off" //clip_state ;//= "off" @@ -1295,125 +1973,272 @@ type tg_axis = class(tg_base) // //user_data ;//= [] //tag ;//= "" private - function draw_axis(cvs,subtks,flg); + function v_to_cvs(tpax,v,x,y); + begin + case tpax of + "x":zoom_to_xyz(v,fytics_coord[1],fytics_coord[2],x,y); + "y":zoom_to_xyz(fytics_coord[0],v,fytics_coord[2],x,y); + "z":zoom_to_xyz(fytics_coord[0],fytics_coord[1],v,x,y); + end; + end + function get_tic_to(direc,size,arg,_x,_y); + begin + pi2 := pi()/2; + if direc=tgc_direct_desc then + begin + p_trans(size,0,-arg-pi2,_x,_y); + end + else + begin + p_trans(size,0,-arg+pi2,_x,_y); + end + return 1; + end + function get_angleofhoriz(xarg,ifh,sz); //获取角度以及位置 + begin + xarg := 0;ifh := false;sz:=0; + tkxys := array(); + get_axis_type(tpax); + if fzoom_bounds then + begin + v_to_cvs(tpax,fzoom_bounds[0],x,y); + tkxys[0] := array(x,y); + v_to_cvs(tpax,fzoom_bounds[1],x2,y2); + tkxys[1] := array(x2,y2); + sz := (x2-x)^2+(y2-y)^2; + if sz>0 then sz := sqrt(sz); + end else + begin + minv := minvalue(fxtics_coord_v); + manv := maxvalue(fxtics_coord_v); + if not(minv0 then xarg := 0; + else xarg := a_180; + end + if isnan(yarg) then + begin + if dxy[1]>0 then yarg := 0; + else yarg := a_180; + end + if xarga_150 then + begin + ifh := true; + end + if like_0( xarg) then + begin + ifh := true; + end else + if a_like_b(xarg,a_180) then + begin + xarg := -xarg; + ifh := true; + end else + if a_like_b(yarg,a_90) then + begin + xarg := 0; + ifh := true; + end else + if yarg = 0 then + begin + xarg := a_90; + end else + if yarg=a_180 then + begin + xarg:=-a_90; + end else + if xarga_90 then //第1 + begin + xarg := -xarg; + end else + if xarg>a_90 and yarg>a_90 then //第2 + begin + xarg :=-xarg; + end else + if yarga_90 then //第3 + begin + end else + if yarg0?pw:0); - tklensub := fsubticksize+(pw>0?pw:0); - vtic := flg .& 1 ; - vtic2 := (flg .&2)?1:-1; - + tksize := pw+fticksize; + tic_space := 3; + tksizesub := fsubticksize+pw; + get_axis_type(tpax); set_lineinfo_to_canvas(cvs); - set_fontinfo_to_canvas(cvs); - + tkxys := array(); + xarg := 0; + ifvert := false; + get_angleofhoriz(xarg,ifvert,sz); + if like_0(sz) then return ; + for i,v in fxtics_coord_v do + begin + v_to_cvs(tpax,v,x,y); + tkxys[i] := array(x,y); + end ///////////////////轴线//////////////////////////////// + if ftics_segment=tgc_on then begin if fzoom_bounds then begin - if vtic then - begin - Coordinate_Mapping(fzoom_bounds[0],fytics_coord,0,x,y); - cvs.moveto(array(x,y)); - Coordinate_Mapping(fzoom_bounds[1],fytics_coord,0,x,y); - cvs.lineto(array(x,y)); - end - else - begin - Coordinate_Mapping(fytics_coord,fzoom_bounds[0],0,x,y); - cvs.moveto(array(x,y)); - Coordinate_Mapping(fytics_coord,fzoom_bounds[1],0,x,y); - cvs.lineto(array(x,y)); - end + v_to_cvs(tpax,fzoom_bounds[0],x1,y1); + v_to_cvs(tpax,fzoom_bounds[1],x2,y2); + cvs.moveto(array(x1,y1)); + cvs.lineto(array(x2,y2)); + x3 := (x1+x2)/2; + y3 := (y1+y2)/2; + ax_pos := array(x1,y1,x2,y2,x3,y3); end else begin - for i,v in fxtics_coord_v do - begin - if vtic then - Coordinate_Mapping(v,fytics_coord,0,x,y); - else Coordinate_Mapping(fytics_coord,v,0,x,y); + for i,v in tkxys do + begin if i=0 then - cvs.moveto(array(x,y)); + cvs.moveto(v); else - cvs.lineto(array(x,y)); + cvs.lineto(v); end end end + ///////////////////////////////////////////////////// //////////////////刻度线以及刻度值/////////////////////////////////////// + ts_size := array(fontinfo.size+4,fontinfo.size*2+4); tcsinfo := array(); + get_tic_to(ftics_direction,tksize,xarg,_xticlen,_yticklen); if ifnumber(ftics_color) then cvs.pen.color := ftics_color; - for i,v in fxtics_coord_v do - begin - if fzoom_bounds and (vfzoom_bounds[1]) then continue; - if vtic then - Coordinate_Mapping(v,fytics_coord,0,x,y); - else Coordinate_Mapping(fytics_coord,v,0,x,y); + for i,vi in fxtics_coord_v do + begin + if fzoom_bounds and (vifzoom_bounds[1]) then continue; + v := tkxys[i]; lbi := ftics_labels[i]; + x := v[0]; + y := v[1]; cvs.moveto(array(x,y)); + + x1 :=x+_xticlen; + y1 := y+_yticklen; + cvs.lineto(array(x1,y1)); + //continue; sz := nil; if lbi then begin sz := array((length(lbi))*fontinfo.size+4,fontinfo.size*2+4) ;//cvs.GetTextExtent(lbi); end - if vtic then - begin - ny := y+(vtic2*tklen); - cvs.lineto(array(x,ny)); - if sz then + if sz then + begin + if ifvert then //x begin - rec := array(x-sz[0]/2,0,x+sz[0]/2,0); - if ny>y then - begin - rec[1] := ny+5; - rec[3] := ny+sz[1]+5; + rec := array(x1-sz[0]/2,0,x1+sz[0]/2,0); + if _yticklen>0 then + begin + rec[1] := y1+tic_space; + rec[3] := y1+sz[1]+tic_space; end else begin - rec[1] := ny-sz[1]-5; - rec[3] := ny-5; - end + rec[1] := y1-sz[1]-tic_space; + rec[3] := y1-tic_space; + end + end else //y + begin + ts_size[1] := max(ts_size[1],sz[0]); + rec := array(0,y1-sz[1]/2,0,y1+sz[1]/2); + if _xticlen>0 then + begin + rec[0] := x1+tic_space; + rec[2] := x1+sz[0]+tic_space; + end else + begin + rec[0] := x1-sz[0]-tic_space; + rec[2] := x1-tic_space; + end end tcsinfo[length(tcsinfo)] := array(lbi,rec,"h"); - //draw_tics(cvs,lbi,rec); - //cvs.drawtext(lbi,rec); end - else - begin - nx := x+(vtic2*tklen); - cvs.lineto(array(nx,y)); - if sz then - begin - rec := array(0,y-sz[1]/2,0,y+sz[1]/2); - if nx>x then - begin - rec[0] := nx+5; - rec[2] := nx+sz[0]+5; - end else - begin - rec[0] := nx-sz[0]-5; - rec[2] := nx-5; - end - //draw_tics(cvs,lbi,rec); - tcsinfo[length(tcsinfo)] := array(lbi,rec,"v"); - //cvs.drawtext(lbi,rec); - end - - end - //cvs.textout(lbi,array(x,y)); end - if tcsinfo then draw_tics(cvs,tcsinfo); + if tcsinfo then + begin + set_fontinfo_to_canvas(cvs); + draw_tics(cvs,tcsinfo); + end ///////////////////////////////////////////////////////////////////////// - ////////////////////子刻度线//////////////////////////////////////////////// + ////////////////////子刻度线//////////////////////////////////////////////// + get_tic_to(ftics_direction,tksizesub,xarg,_xstic,_ystic); for i,v in subtks do begin - if vtic then - Coordinate_Mapping(v,fytics_coord,0,x,y); - else Coordinate_Mapping(fytics_coord,v,0,x,y); + v_to_cvs(tpax,v,x,y); cvs.moveto(array(x,y)); - if vtic then - cvs.lineto(array(x,y+(vtic2*tklensub))); - else - cvs.lineto(array(x+(vtic2*tklensub),y)); + //get_tic_to(ftics_direction,tksizesub,xarg,_x,_y); + cvs.lineto(array(_xstic+x,y+_ystic)); + end + //if not ax_pos then return ; + if flabel is class(tg_label_axis) then //绘制标签 + begin + //tx := ax_pos[2]-ax_pos[1] + if flabel.visible<>tgc_on then return ; + t := flabel.text; + if not t then return ; + if not fzoom_bounds then return ; + lbft := flabel.fontinfo; + sz := lbft.size; + set_fontinfo_to_canvas(cvs,lbft); + _x := _xticlen; + _y := _yticklen; + bs :=2;//xarg<0?1:2;//(xarg<0?2.2:0.2); + slen := sz*length(t); + zlen := max(abs(ax_pos[2]-ax_pos[0]),abs(ax_pos[3]-ax_pos[1])); + rt := (1-slen/zlen); + tx := fzoom_bounds[0] + (rt>0? (rt*(fzoom_bounds[1]-fzoom_bounds[0])/2):0); + v_to_cvs(tpax,tx,x1,y1); + + nxarg := (r_2_a(xarg) mod 180);//abs()*pi()); + //echo "\r\narg:",r_2_a(xarg),"===",nxarg; + nxarg := nxarg*pi()/180; + if _y<0 then _y-=ts_size[0]+tic_space+sz*bs; + else _y+=ts_size[0]+tic_space+sz*bs; + if _x<0 then _x -= sz*bs+ts_size[1]+tic_space; + else _x+=sz*bs+ts_size[1]+tic_space; + nx := x1+_x;//ax_pos[4]+_x; + ny := y1+_y;//ax_pos[5]+_y; + if like_0(nxarg) then + begin + cvs.textout(t,array(nx,ny)); + end else + begin + cvs.SaveDC(); + cvs.trans(-nxarg,nx,ny); + cvs.textout(t,array(0,0)); + cvs.RestoreDC(); + end end end function set_zoom_bounds(v); @@ -1428,7 +2253,7 @@ type tg_axis = class(tg_base) // end function set_tics_direction(v); begin - if v<>ftics_direction and ( v in array(tgc_top,tgc_left,tgc_right,tgc_bottom)) then + if v<>ftics_direction and ( v in array(tgc_direct_asc,tgc_direct_desc)) then begin ftics_direction := v; prop_changed("tics_direction",v); @@ -1474,21 +2299,33 @@ type tg_axis = class(tg_base) // prop_changed("xtics_coord",v); end end + function ytics_ok(v); + begin + if ifarray(v) and length(v)>=3 then + begin + nmc := 0; + for i := 0 to 2 do + begin + if ifnumber(v[i]) then nmc++; + end + return nmc=2; + end + end function set_ytics_coord(v); begin - if v<> fytics_coord then - begin + if v<> fytics_coord and ytics_ok(v) then + begin fytics_coord := v; prop_changed("ytics_coord",v); end end function set_tics_segment(v); begin - nv := v?true:false; - if ftics_segment<>v then + if not tg_boolen_value(n,nv) then return ; + if ftics_segment<>nv then begin - ftics_segment := v; - prop_changed("tics_segment",v); + ftics_segment := nv; + prop_changed("tics_segment",nv); end end function set_tics_color(v); @@ -1564,6 +2401,7 @@ type tg_axis = class(tg_base) // end end end + type tg_text = class(tg_base) public function create(pms); @@ -1578,7 +2416,7 @@ type tg_text = class(tg_base) begin if (visible<>tgc_on) then return ; if not fdata then return ; - if not Coordinate_Mapping(fdata[0],fdata[1],fdata[2],x,y) then return ; + if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ; if clip_state=tgc_on then cvs.axesclip(); else cvs.axesunclip(); get_text_size(w,h,hi); @@ -1693,7 +2531,7 @@ type tg_label =class(tg_base) // if not axes_mapping(p[0],p[1],0,x_,y_) then return ; end else //tgc_by_coordinates: begin - if not Coordinate_Mapping(p[0],p[1],0,x_,y_) then return ; + if not zoom_to_xyz(p[0],p[1],0,x_,y_) then return ; end end if ffont_angle<>0 then @@ -1809,7 +2647,6 @@ type tg_compound = class(tg_graph) // return (not(p)) or (p is class(tg_compound)) or (p is class(tg_axes)); end end - type tg_tips = class(tg_base) //提示 function create(pms); begin @@ -1859,7 +2696,7 @@ type tg_tips = class(tg_base) // ws := max(ws,length(v)*w+w); hs[i] := h+4; end - Coordinate_Mapping(d[0],d[1],z,x_,y_); + zoom_to_xyz(d[0],d[1],z,x_,y_); sz := array(ws,sum(hs)); if mark_mode = tgc_on then begin @@ -2110,11 +2947,11 @@ type tg_legend = class(tg_base) //图 x := arec[2]; y := arec[1]; rc := get_rect_at_corner(x,y,lw,lh,0,3); - Coordinate_unMapping(rc[0],rc[1],_x,_y,_z); + xyz_to_zoom(rc[0],rc[1],0,_x,_y,_z); fposition := array(_x,_y); end else begin - Coordinate_Mapping(fposition[0],fposition[1],0,_x,_y); + zoom_to_xyz(fposition[0],fposition[1],0,_x,_y); rc:= array(_x,_y,_x+lw,_y+lh); end cvs.draw_rect().rect(rc).draw(); @@ -2362,17 +3199,39 @@ type tg_Polyline = class(tg_graph) // function paint(cvs);override; begin if tgc_on<> visible then return ; - if clip_state=tgc_on then cvs.axesclip(); - else cvs.axesunclip(); + if clip_state=tgc_on then + begin + //cvs.axesclip(); + bx := axes.zoom_box; + pts := array(); + for i,v in rec_to_points( array(bx[0,0],bx[1,0],bx[0,1],bx[1,1])) do + begin + zoom_to_xyz(v[0],v[1],bx[2,0],x,y); + pts[i] := array(x,y); + end + cvs.clip_rgn(pts); + end else + begin + cvs.axesunclip(); + end + //echo tostn(bx); xys := array(); set_lineinfo_to_canvas(cvs); + ys := array(); for i,v in fgraph_data do begin - if not Coordinate_Mapping(v[0],v[1],z,x,y) then return ; - xys[i] := array(integer(x),integer(y)); + if not zoom_to_xyz(v[0],v[1],bx[2,0],x,y) then return ; + xys[i] := array(integer(x),integer(y)); + case fpolyline_style of + tgc_LS_bar,tgc_LS_barplot,tgc_LS_filled: + begin + zoom_to_xyz(v[0],0,0,x,y) ; + ys[i] := array(x,y); + end + end; end - Coordinate_Mapping(0,0,0,x,y); - paint_lines(cvs,fpolyline_style,xys,fclosed,array("line_mode":line_mode,"bar_width":fbar_width,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"x":x,"y":y)); + //zoom_to_xyz(0,0,0,x,y); + paint_lines(cvs,fpolyline_style,xys,fclosed,array("line_mode":line_mode,"bar_width":fbar_width,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys)); mk := markinfo; if mark_mode=tgc_on and mk.size>2 then begin @@ -2405,7 +3264,7 @@ type tg_Polyline = class(tg_graph) // paint_marks(mk,cvs,xys); end end - property closed read fclosed write fclosed;//= "off" + property closed read fclosed write set_line_closed;//= "off" property polyline_style read fpolyline_style write set_polyline_style;//= "0" property bar_width read fbar_width write fbar_width;//= "0" private @@ -2447,7 +3306,16 @@ type tg_Polyline = class(tg_graph) // inherited; end end - private + private + function set_line_closed(v); + begin + if not tg_boolen_value(v,nv) then return ; + if nv<>fclosed then + begin + fclosed := nv; + prop_changed("closed",nv); + end + end function set_polyline_style(v); begin if v<>fpolyline_style then @@ -2455,7 +3323,6 @@ type tg_Polyline = class(tg_graph) // fpolyline_style := v; end end - end type tg_line_info = class(tg_const) function create(); @@ -2476,7 +3343,7 @@ type tg_line_info = class(tg_const) FStyle; fbkcolor; end -type tg_font_info = class(tg_const) +type tg_font_info = class(tg_const) //字体信息 function create(); begin fstyle := nil; @@ -2495,7 +3362,7 @@ type tg_font_info = class(tg_const) fforeground; fbackground; end -type tg_mark_info = class(tg_const) +type tg_mark_info = class(tg_const) //标记信息 function create(); begin fstyle := tgc_mks_dot; @@ -2521,6 +3388,7 @@ type tg_base = class(TNode,tg_const) // function create(pms); begin class(TNode).create(); + fchange_locked := false; fclip_state := tgc_on; fvisibe := tgc_on; fline_mode := tgc_off; @@ -2541,16 +3409,16 @@ type tg_base = class(TNode,tg_const) // if p then return p.axes_unmapping(x,y,z,_x,_y); return false; end - function Coordinate_Mapping(x,y,z,_x,_y);virtual; + function zoom_to_xyz(x,y,z,_x,_y,_z);virtual; begin p := get_axes(); - if p then return p.Coordinate_Mapping(x,y,z,_x,_y); + if p then return p.zoom_to_xyz(x,y,z,_x,_y,_z); return false; end - function Coordinate_unMapping(x,y,x_,y_,z_);virtual; + function xyz_to_zoom(x,y,z,x_,y_,z_);virtual; begin p := get_axes; - if p then return p.Coordinate_unMapping(x,y,x_,y_,z_); + if p then return p.xyz_to_zoom(x,y,z,x_,y_,z_); return false; end function executecommand(cmd,pm);virtual; @@ -2611,6 +3479,7 @@ type tg_base = class(TNode,tg_const) // property lineinfo read flineinfo; property markinfo read fmarkinfo; property fontinfo read ffontinfo; + property change_locked read fchange_locked write fchange_locked; public user_data; @@ -2630,8 +3499,13 @@ type tg_base = class(TNode,tg_const) // end function prop_changed(n,v);virtual; //改变通知 begin + if fchange_locked then return ; axs := get_axes(); - if axs then fg := axs.figure; + if axs then + begin + if axs.change_locked then return ; + fg := axs.figure; + end if fg then begin fg.executecommand("figure_need_fresh",p); @@ -2658,6 +3532,7 @@ type tg_base = class(TNode,tg_const) // flineinfo; fmarkinfo; ffontinfo; + fchange_locked; function set_clip_state(v); begin if tg_boolen_value(v,nv) and (nv<>fclip_state) then @@ -2699,6 +3574,9 @@ type tg_const = class() static const tgc_box_on = "on"; static const tgc_box_half = "half"; /////////////坐标轴/////////////////// + static const tgc_direct_asc = "asc"; + static const tgc_direct_desc = "desc"; + static const tgc_top = "top"; static const tgc_bottom = "bottom"; static const tgc_left = "left"; @@ -2764,341 +3642,7 @@ type tg_const = class() ////////////// end implementation -type tg_3d_box = class() - function create(); - begin - ftheta := 0; - falpha := 0; - f_changed := 0; - flinesindex := array( - (0,1), - (1,2), - (2,3), - (3,0), - - (4,5), - (5,6), - (6,7), - (7,4), - - - (0,4), - (1,5), - (2,6), - (3,7) - - - ); - fvectorsindex := array( - (0,1,2,3), - (0,4,7,3), - (0,1,5,4), - (1,5,6,2), - (2,6,7,3)//, - //(4,5,6,7), - - ); - fbounds := array(0,0,200,200); - fsizes := array(200,200,200); - frotemt := eye(3); - fvcenter := array(100,100,100); - fzoombounds := array((0,200),(0,200),(0,200)); - //fvectors :=init_vecs(200,200,200) ; - faces := array(); - FRates := array(1,1,1); - frevers := array(1,1,0); - end - - function set_trans(t,a); //设置转换角度 - begin - if (t=ftheta) and (falpha=a) then return ; - ftheta := t; - falpha := a; - c := cos(a); - s := sin(a); - c1 := cos(t); - s1 := sin(t); - frotemt := array((0,1,0),(1,0,0),(0,0,1)):*array((c,s,0),(-s,c,0),(0,0,1)):*array((1,0,0),(0,c1,s1),(0,-s1,c1)); - //frotemt := array((1,0,0),(0,c1,s1),(0,-s1,c1)):*array((c,s,0),(-s,c,0),(0,0,1)):*array((0,1,0),(1,0,0),(0,0,1)); - f_changed := true; - end - function refresh_box();//重算坐标框架 - begin - if f_changed then - begin - f_changed := 0; - recalc_size(); - end - end - function transxyz(x,y,z,_x,_y,_z); //旋转数据 - begin - r := array((x,y,z)):*frotemt; - _x := r[0,0]; - _y := r[0,1]; - _z := r[0,2]; - end - function untransxyz(x,y,z,_x,_y,_z); - begin - r := array((x,y,0)):/frotemt; - _x := r[0,0]; - _y := r[0,1]; - _z := r[0,2]; - end - function zoom_to_xy(x,y,z,_x,_y,_z); //---------- - begin - if frevers[0] then x0 := fsizes[0]/2-(x-fzoombounds[0,0])/FRates[0]; - else - x0 := (x-fzoombounds[0,0])/FRates[0] -fsizes[0]/2; - if frevers[1] then y0 := fsizes[1]/2-(y-fzoombounds[1,0])/FRates[1]; - else y0 := (y-fzoombounds[1,0])/FRates[1] -fsizes[1]/2; - if frevers[2] then z0 := fsizes[2]/2-(z-fzoombounds[2,0])/FRates[2]; - else z0 := (z-fzoombounds[2,0])/FRates[2] -fsizes[2]/2; - transxyz(x0,y0,z0,x1,y1,_z); - x1 +=fvcenter[0]; - y1 +=fvcenter[1]; - _x := x1; - _y := y1; - end - property theta read ftheta; - property alpha read falpha; - property bounds read fbounds write set_bounds; - property zoombounds read gs_zoombounds write gs_zoombounds; - property size read get_size; - - function paint_box(cvs); - begin - r := array(); - cvs.pen.color := 0xff0000; - lines := array(); - ps2 := array(); - inpoints := array(); - echo "\r\n>>>",(abs(ftheta/pi()) mod 2); - if (abs(ftheta/pi()) mod 2)=0 then - begin - for i:= 0 to 3 do - begin - if point_in_rgn(fvectors[4:7],fvectors[i]) then - begin - inpoints[length(inpoints)] := i; - end - end - end else - begin - for i:= 4 to 7 do - begin - if point_in_rgn(fvectors[0:3],fvectors[i]) then - begin - inpoints[length(inpoints)] := i; - end - end - end - hd := array(); - for i,v in flinesindex do - begin - - ps := fvectors[v]; - if (inpoints intersect v) then hd[i] := true; - for j,vj in ps do - lines[i,j] := vj[0:1]+fvcenter; - //cvs.draw_polyline().points(ps1).draw(); - end - - - for i,v in lines do - begin - ps1 := v; - if hd[i] then cvs.pen.style := 1; - else cvs.pen.style := 0; - cvs.draw_polyline().points(ps1).draw(); - end - - return ; - for i,v in fvectorsindex do - begin - ps := fvectors[v,0:1]; - ps1 := array(); - for j,vj in ps do - ps1[j] := vj+fvcenter; - ps1[j+1] := ps1[0]; - cvs.draw_polyline().points(ps1).draw(); - //break; - end - end - private - //////////长宽高//////////////////// - fvcenter; //中心 - ////////////////////// - fvectorsindex; //定点次序 - flinesindex;// - ftheta; - falpha; - frotemt; - fbounds; - f_changed; - fzoombounds; - fvectors; - FRates; - fsizes; - frevers; - private - function gs_zoombounds(idx,v); //小刻度线 - begin - if ifarray(idx) then - begin - if ifarray(v) then - begin - for i,vi in idx do - begin - gs_zoombounds(vi,v[vi]); - end - end else - begin - r := array(); - for i,vi in idx do - begin - return gs_zoombounds(vi); - end - end - end - if ifarray(v) and ifnumber(v[0]) and (v[0]v then - begin - fbounds := v; - f_changed := true; - end - end - function get_size(); - begin - return fsizes; - end - function get_new_w_h(w1,h1,w,h,z); - begin - z1 := (w1+h1)/2; - z := z1; - w := w1; - h := h1; - while true do - begin - ps := init_vecs(h,w,z); - bd := zeros(2,2); - for i,v in ps do - begin - transxyz(v[0],v[1],v[2],_x,_y,_z); - bd[0,0] := min(_x,bd[0,0]); - bd[0,1] := max(_x,bd[0,1]); - bd[1,0] := min(_y,bd[1,0]); - bd[1,1] := max(_y,bd[1,1]); - end - bw := bd[0,1]-bd[0,0]; - bh := bd[1,1]-bd[1,0]; - if bw10 then return (x+jd=jd); + return (x+1000)=1000; +end +function a_like_b(a,b,jd); +begin + return like_0(a-b); +end +function r_2_a(arg); +begin + return arg*180/pi(); +end +function a_2_r(arg); +begin + return arg*pi()/180; +end +function d2angle(v1,v2); //角度计算 +begin + return arccos(sum(v1*v2)/vectorsize(v1)/vectorsize(v2)); +end +function vectorsize(v); //向量长度 +begin + return (v[0]^2+v[1]^2)^0.5; +end function rec_to_points(rec); begin return array(rec[array(0,1)],rec[array(2,1)],rec[array(2,3)],rec[array(0,3)],rec[array(0,1)]); end //////////////////////////////////////// initialization - finalization - end. \ No newline at end of file diff --git a/funcext/tvclib/uwindowsinterface.tsf b/funcext/tvclib/uwindowsinterface.tsf index 3f036d7..0736936 100644 --- a/funcext/tvclib/uwindowsinterface.tsf +++ b/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