From 8202de23c9879d1698e2350c0f4cabfbf27ab8f0 Mon Sep 17 00:00:00 2001 From: tslediter Date: Mon, 11 Mar 2024 16:05:50 +0800 Subject: [PATCH] =?UTF-8?q?=E7=95=8C=E9=9D=A2=E5=BA=93?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 减少c的依赖 --- designer/udesignerproject.tsf | 1 + designer/utslvcldesigner.tsf | 1 + funcext/tvclib/cstructurelib.tsf | 2509 ++++++++++++-------------- funcext/tvclib/getdlsymaddress.tsf | 5 +- funcext/tvclib/parserch.tsf | 279 +++ funcext/tvclib/tgdiplusflat.tsf | 38 +- funcext/tvclib/ugtkinterface.tsf | 125 +- funcext/tvclib/utslvclgdi.tsf | 196 +- funcext/tvclib/utvclgraphics.tsf | 1980 +++++++++++++------- funcext/tvclib/uwindowsinterface.tsf | 4 +- 10 files changed, 2969 insertions(+), 2169 deletions(-) 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; //дij; - _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) дij%% - @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