liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

减少c的依赖
This commit is contained in:
tslediter 2024-03-11 16:05:50 +08:00
parent ae3f3b00f6
commit 8202de23c9
10 changed files with 2969 additions and 2169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
designer/udesignerproject.tsf
View File

@ -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

1
designer/utslvcldesigner.tsf
View File

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

2229
funcext/tvclib/cstructurelib.tsf
View File

File diff suppressed because it is too large Load Diff

5
funcext/tvclib/getdlsymaddress.tsf
View File

@ -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

279
funcext/tvclib/parserch.tsf
View File

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

38
funcext/tvclib/tgdiplusflat.tsf
View File

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

111
funcext/tvclib/ugtkinterface.tsf
View File

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

190
funcext/tvclib/utslvclgdi.tsf
View File

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

1886
funcext/tvclib/utvclgraphics.tsf
View File

File diff suppressed because it is too large Load Diff

4
funcext/tvclib/uwindowsinterface.tsf
View File

@ -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