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

界面库 

添加绘图功能库
This commit is contained in:
tslediter 2024-01-26 16:37:33 +08:00
parent 5d69525909
commit eccc96de15
6 changed files with 1926 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
funcext/tvclib/tcustomcontrol.tsf
View File

@ -11,11 +11,14 @@ type tcustomcontrol=class(TWinControl)
begin
//odh := canvas.Handle;
Canvas.Handle := dc;
Canvas.ClipRect := PAINTSTRUCT().rcpaint();
canvas.font := font;
canvas.brush.Color := Color;
Canvas.requiregdi();
Canvas.rcpaint := PAINTSTRUCT().rcpaint();
try
Paint();
finally
Canvas.Handle := odh;
Canvas.Handle := 0;
end;
end
procedure Paint();override;

11
funcext/tvclib/twincontrol.tsf
View File

@ -241,7 +241,12 @@ type TWinControl = class(tcontrol)
begin
factivated := false;
FWsPopUp := nv;
if HandleAllocated()then RecreateWnd();
vb := Visible;
if HandleAllocated()then
begin
RecreateWnd();
if vb and nv then show(); //处理顶层窗口的显示
end
end
end
function GetWsPopUp();virtual;
@ -1257,6 +1262,8 @@ type TWinControl = class(tcontrol)
memdc := _wapi.CreateCompatibleDC(0);
if not memdc then exit;
oldmp := _wapi.SelectObject(memdc,mbit);
_wapi.SaveDC(memdc);
_wapi.SetGraphicsMode(memdc,2);
{$else}
cr := ClientRect;
@ -1280,6 +1287,7 @@ type TWinControl = class(tcontrol)
rc := ps.rcpaint;
{$ifdef gdipaint}
_wapi.RestoreDC(memdc,-1);
_wapi.BitBlt(dc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1],memdc,rc[0],rc[1],SRCCOPY); //_wapi.BitBlt(dc,c[0],c[1],c[2],c[3],memdc,0,0,SRCCOPY);
{$else}
_wapi.SelectClipRgn(memdc,0);
@ -1420,6 +1428,7 @@ type TWinControl = class(tcontrol)
end
procedure PaintHandler(var TheMessage:TLMPaint); //type_twinctrol
begin
hdc := TheMessage.wparam;
PaintWindow(TheMessage.wparam);
//c := ClientRect;
c := array(0,0); //ÉèÖûù×¼µã,Ϊ00 20201112 ÐÞ¸Ä

40
funcext/tvclib/ugtkinterface.tsf
View File

@ -1824,9 +1824,42 @@ type tsgtkapi = class(tgtkapis)
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
end
Function Polygon(hdc :pointer;points:array of integer;n:integer):integer;
Function Polygon(dc :pointer;points:array of integer;n:integer):integer;
begin
if n<3 then return ;
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
pc := gtk_object_get_data(dc,"pen.color");
brc := gtk_object_get_data(dc,"brush.color");
pw := gtk_object_get_data(dc,"pen.width");
if pw>0 then cairo_set_line_width(dc,pw);
else cairo_set_line_width(dc,1);
//cairo_move_to(dc,points[0]+x,Points[1]+y);
cairo_applay_pen_style(dc);
for i := 0 to n-1 do
begin
cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y);
end
cairo_line_to(dc,Points[0,0]+x,Points[0,1]+y);
if brc=0 then
begin
cairo_set_source_rgb(dc,0,0,0);
end else
begin
gtk_rgb_color_rgb(brc,rc,gc,bc);
cairo_set_source_rgb(dc,rc,gc,bc);
end
cairo_fill_preserve(dc);
if pc=0 then
begin
cairo_set_source_rgb(dc,0,0,0);
end else
begin
gtk_rgb_color_rgb(pc,rc,gc,bc);
cairo_set_source_rgb(dc,rc,gc,bc);
end
cairo_stroke(dc);
end
Function PolyBezier(dc :pointer;points:array of integer;n:integer):integer;
begin
@ -1875,11 +1908,10 @@ type tsgtkapi = class(tgtkapis)
gtk_rgb_color_rgb(pc,rc,gc,bc);
cairo_set_source_rgb(dc,rc,gc,bc);
end
cairo_move_to(dc,points[0]+x,Points[1]+y);
cairo_applay_pen_style(dc);
for i := 1 to n-1 do
for i := 0 to n-1 do
begin
cairo_line_to(dc,Points[i*2]+x,Points[i*2+1]+y);
cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y);
end
cairo_stroke(dc);
end

2
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -2226,7 +2226,7 @@ type TIniFileExter=class()
ffilename;
finiobj;
end
type TCanvsRgnClipAutoSave=class
type TCanvsRgnClipAutoSave=class()
{**
@expan(说明) 裁剪canvas区域,销毁时还原 %%
**}

85
funcext/tvclib/utslvclgdi.tsf
View File

@ -524,7 +524,7 @@ type tcustompen=class(tgdi)
begin
w := FWidth;
end else
w := 0;
w := 0;
hp := _wapi.CreatePen(FStyle,w,FColor);
addsource(hp);
end
@ -2339,6 +2339,7 @@ type TcustomCanvas = class(TSLUIBASE)
FFont := new Tcustomfont();
FFont.Canvas := self;
FTEXTMETRICA := new ttagTEXTMETRICA();
_xformobj := new Ttagxform();
end
function Recycling();override;
begin
@ -2627,6 +2628,17 @@ type TcustomCanvas = class(TSLUIBASE)
if HandleAllocated() then requiregdi();
return new tshapeBezier(self(true));
end
function draw_polygon(); //填充折线绘制
begin
if HandleAllocated() then requiregdi();
return new tshapepolygon(self(true));
end
function draw_polyline(); //折线绘制
begin
if HandleAllocated() then requiregdi();
return new tshapepolyline(self(true));
end
function draw(name_,points,f,m);
begin
{**
@ -2738,8 +2750,6 @@ type TcustomCanvas = class(TSLUIBASE)
{$ifdef linux}
return r;
{$endif}
if not _xformobj then
_xformobj := new Ttagxform();
_xformobj.em11 := trans[0];
_xformobj.em12 := trans[1];
_xformobj.em21 := trans[2];
@ -2748,6 +2758,25 @@ type TcustomCanvas = class(TSLUIBASE)
_xformobj.edy := trans[5];
return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
end
function trans(ag,x,y);
begin
{**
@explan(说明)文本旋转%%
@param(ag)(double) 角度%%
**}
{$ifdef linux}
_wapi.cairo_translate(FHandle,x,y);
_wapi.cairo_rotate(FHandle,-ag);
return 1;
{$endif}
_xformobj.em11 := cos(ag);
_xformobj.em12 := -sin(ag);
_xformobj.em21 := sin(ag);
_xformobj.em22 := cos(ag);
_xformobj.edx := ifnumber(x)?x:0;
_xformobj.edy := ifnumber(y)?y:0;
return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
end
function SetPolyFillMode(md); //ÉèÖÃÌî³äÑùʽ
begin
{**
@ -2864,7 +2893,7 @@ type TControlCanvs=class(TcustomCanvas)
begin
inherited;
end
property ClipRect read FClipRect write SetClipRect;
property rcpaint read FClipRect write SetClipRect;
private
Function SetClipRect(v);
begin
@ -3181,6 +3210,54 @@ type tshapechord = class(tshape,tshaperect,tsepoint)
return inherited;
end
end
type tshapepolygon = class(tshape)
function create(dc);
begin
inherited;
fbpoints := array();
end
function draw();override;
begin
if fcanvas and fcanvas.HandleAllocated() and fbpoints then
begin
fcanvas._wapi.Polygon(fcanvas.handle,fbpoints,length(fbpoints));
end
return inherited;
end
function points(ps);virtual;
begin
tps := array();
for i,v in ps do
begin
if ifarray(v) and ifnumber(v[0]) and ifnumber(v[1]) then
begin
tps[idx++] := array(v[0],v[1]);
end
end
if length(tps)>2 then
begin
fbpoints := tps;
end
return self(true);
end
protected
fbpoints;
end
type tshapepolyline = class(tshapepolygon)
function create(dc);
begin
inherited;
end
function draw();override;
begin
if fcanvas and fcanvas.HandleAllocated() and fbpoints then
begin
fcanvas._wapi.polyline(fcanvas.handle,fbpoints,length(fbpoints));
end
return self(true);
end
end
type tshapeBezier = class(tshape)
function create(dc);
begin

1790
funcext/tvclib/utvclgraphics.tsf Normal file
View File

File diff suppressed because it is too large Load Diff