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

更新界面库，以及tsl64

This commit is contained in:
liujianjun 2024-12-24 16:19:48 +08:00
parent 40e56f2167
commit 0177f8d9c9
39 changed files with 3704 additions and 1093 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
designer/gettsleditorstart.tsf
View File

@ -1,6 +1,7 @@
//启动tsl编辑器
//20230421 整理代码
uses tslvcl;
setprocessdpiawareness(2);
deletefuncacheini(); //清空缓存
ops := ""; //待打开文件
GLobal G_OpenHostory;

1
designer/gettslvcldesignerstart.tsf
View File

@ -2,6 +2,7 @@
tsl界面设计器启动程序
}
uses tslvcl,utslvclDesigner;
setprocessdpiawareness(2);
deletefuncacheini();
isdebug := false;
willopen := "";

2
designer/teditorform.tsf
View File

@ -418,6 +418,8 @@ type teditorform = class(TVCform) //
begin
global g_editer_font_size := ginfo["font"];
FEdter.getpage().font := ginfo["font"];
FEdter.getcodemap().font := ginfo["font"];
//Fdirview.addrootdirs(dirs);
end
if importfile(ftstream(),"",fdirspath,dirs)=1 then

9
designer/udesignerproject.tsf
View File

@ -364,7 +364,7 @@ type TProjectView = class(TVCForm) //
imgs := New TControlImageList(self);
imgs.width := 24;
imgs.height := 24;
imgs.DrawBimpFirst := true;
imgs.DrawBmpFirst := true;
EditToolBmps := array();
for i,v in GetToolBtns() do
begin
@ -1100,7 +1100,7 @@ type TProjectView = class(TVCForm) //
sdir[idx++] := Getfuncextdir();
end
/////////////////////////////////////
FTslEditer.TslSearchDir := sdir;//array(p,Getfuncextdir());
FTslEditer.TslSearchDir := sdir;
FExecEntry := FprojName;
if d["entryscript"]then
begin
@ -1923,9 +1923,7 @@ end
end
function GetVCLdir();
begin
//return Getfuncextdir()+ioFileseparator()+"tvclib";
return Getfuncextdir();//+ioFileseparator()+"tvclib";
return tsl;
return Getfuncextdir()+ioFileseparator()+"tvclib"; //将vcl设置为只读
end
function Getfuncextdir();
begin
@ -2449,6 +2447,7 @@ type TFileTree = class(TTreeCtl)
fprojectpath := "";
fio := ioFileseparator();
ImageList := CreateaImageList(self,FImageIdName);
ImageList.DrawBmpFirst := true;
hasline := true;
nodecreator := class(TTNode);
FPNode := CreateTreeNode();

12
designer/utslcodeeditor.tsf
View File

@ -71,6 +71,7 @@ type TPage=class(TCustomControl) //
function Create(AOwner)
begin
Inherited;
ParentFont := false;
FCloseBtn := false;
FPageItems := new TMyarrayB();
FMultiLine := 1;
@ -151,6 +152,7 @@ type TPage=class(TCustomControl) //
end
function Paint();override; //»æÖÆ
begin
if not FPageItems then return ;
dc := Canvas;
ps := PAINTSTRUCT().rcPaint;
//dc.Pen.Color := rgb(180,180,100);
@ -494,6 +496,8 @@ type TPage=class(TCustomControl) //
end
function CalcPageItemRect(); //¼ÆËãλÖÃ
begin
FLines := 1;
if not FPageitems then return ;
li := 0;
cw := Font.Width;
r := class(TCustomControl).ClientRect;
@ -1924,7 +1928,7 @@ type TEditer=class(TCustomcontrol) //
end
end
FImages.DrawBimpFirst := true;
FImages.DrawBmpFirst := true;
Fdbgbtns := dbgbtns;
FTslDebug.addbtns(dbgbtns);
//FToolbar.ImageList := FImages;
@ -3863,6 +3867,10 @@ type TEditer=class(TCustomcontrol) //
begin
return FPageEditer;
end
function getcodemap();
begin
return FinCodemap.ftree;
end
protected
class function Sinit();override;
begin
@ -5134,6 +5142,7 @@ type tfincodemap = class(tcustomcontrol)
FList.Parent := self;
initbtn();
FTree := new TTreeView(self);
FTree.ParentFont := false;
FTree.OnSelChanged := thisfunction(SynNodeSelected);
FTree.Parent := self;
FTree.onsyskeydown := function(o,e)begin
@ -5499,6 +5508,7 @@ type TFindListWnd=class(TListBox) //
function Create(AOwner);
begin
inherited;
ParentFont := false;
onnotification := function(o,e)begin
ms := e.message;
if ifarray(ms) and ms[0] ="font" then

8
designer/utslsynmemo.tsf
View File

@ -2164,7 +2164,7 @@ type TTsfFileParser = class() //
FFileNames[fn] := pfn;
if ifstring(d) and d=flt then
begin
ReadParseredFile(fn);
if ReadParseredFile(fn,nil,pfn) then
return ;
end
if readFile(rwRaw(),"",pfn,0,sz,rdd) then
@ -2256,7 +2256,7 @@ type TTsfFileParser = class() //
end
end
end
function ReadParseredFile(n,g); //读取解析的文件
function ReadParseredFile(n,g,pfn); //读取解析的文件
begin
if FCacheDir then
begin
@ -2282,6 +2282,10 @@ type TTsfFileParser = class() //
begin
FCacheS[ln] := d;//new tparserdobject(d);
FFilePaths[ln] := d["fullpath"];
if pfn and ( pfn<>d["fullpath"]) then
begin
return 0;
end
nns := d["nspace"];
if nns then
begin

108
designer/utslvcldcomponents.tsf
View File

@ -941,6 +941,7 @@ type TDVirutalWindow = class(TCustomControl) //
@explan(说明) 非可视控件的窗口容器 %%
**}
private
fminusfileds;
FBitmap; //图标
FBindComponent;//绑定的设计控件
FWindowFileds; //窗口的属性
@ -976,6 +977,7 @@ type TDVirutalWindow = class(TCustomControl) //
public
function Create(AOwner);override;
begin
fminusfileds := array();
inherited;
width := 30;
height := 30;
@ -1009,9 +1011,9 @@ type TDVirutalWindow = class(TCustomControl) //
if r2 then
begin
deletefiled(r2);
return (r union r2);
r := (r union r2);
end
return r;
return minus_fileds(r);
end
function GetPublishEvents();override; //获得消息处理函数
begin
@ -1033,6 +1035,7 @@ type TDVirutalWindow = class(TCustomControl) //
deletefiled(r2);
r union= r2;
end
return minus_fileds(r);
return r;
end
function SetPublish(n,v,pp);override; //设置属性
@ -1057,10 +1060,25 @@ type TDVirutalWindow = class(TCustomControl) //
end
property BindComp read FBindComponent write SetBindComponent;
property WindowFileds read FWindowFileds write FWindowFileds;
property minusfileds read fminusfileds write fminusfileds;
{**
@param(BindComp)(tcomponent) 绑定的控件 %%
@param(WindowFileds)(array of string) 容器控件替代的属性 %%
**}
private
function minus_fileds(r);
begin
ds := array();
for i,v in fminusfileds do
begin
if ifstring(v) and v then ds[lowercase(v)] := nil;
end
if ds then
begin
reindex(r,ds);
end
return r;
end
end
//控件树节点
@ -1462,12 +1480,19 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
{**
@explan(说明) label 控件替代窗口 %%
**}
function paint();override;
begin
canvas.Font := font;
al := BindComp.TextAlign;
BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
bd := BindComp;
cvs := canvas;
//if not bd.ParentFont then cvs.Font := bd.Font;
bd.canvas.Handle := cvs.Handle;
bd.Font := Font;
bd.width := width;
bd.height := height;
bd.paint();
//canvas.Font := font;
//al := BindComp.TextAlign;
//BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al);
end
function SetPublish(n,v,pp);override;
begin
@ -1479,12 +1504,49 @@ type TGraphicLabelWindow = class(TDVirutalWindow)
function Create(AOwner);override;
begin
inherited;
Parentcolor := true;
BindComp := new tlabel(self);
width := BindComp.width;
height := BindComp.Height;
WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","border","caption","visible","align","anchors");
WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","border","visible","align","anchors");
end
function DesigningSizer();override;
begin
return true;
end
end
type TGraphicbevelWindow = class(TDVirutalWindow)
{**
@explan(说明) tbevel 控件替代窗口 %%
**}
function paint();override;
begin
bd := BindComp;
bd.width := width;
bd.height := height;
bd.canvas.Handle := canvas.Handle;
bd.paint();
end
function SetPublish(n,v,pp);override;
begin
r := inherited;
if n="bkbitmap" then bkbitmap := v;
if (n="font" or n="bkbitmap" or n="style" or n="shape") then InvalidateRect(nil,true);
return r;
end
function Create(AOwner);override;
begin
inherited;
Border := false;
Parentcolor := true;
bd := new tbevel(self);
bd.Caption := "";
width := bd.width;
height := bd.Height;
BindComp := bd;
WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","visible","align");
minusfileds := array("caption","popupMenu","action","border","anchors");
end
function DesigningSizer();override;
begin
return true;
@ -1573,6 +1635,35 @@ type TDLabel = class(TDComponent)
inherited;
end
end
type TDbevel = class(TDComponent)
{**
@explan(说明) tbevel控件 %%
**}
function HitTip();override;
begin
return inherited;
end
function IsContainer();override;
begin
return false;
end
function ComponentClass();override;
begin
return class(tbevel);
end
function WndClass();override;
begin
return Class(TGraphicbevelWindow);
end
function bitmapinfo();override;
begin
return getbevelbitmapinfo();
end
function Create(AOwner);override;
begin
inherited;
end
end
type tdsplitter = class(TDComponent)
{**
@explan(说明) label控件 %%
@ -3806,6 +3897,7 @@ begin
class(TDmessagebox),
class(TDBtn),
class(TDLabel),
class(TDbevel),
class(tdsplitter),
class(TDEdit),
class(TDpassword),

6
designer/utslvcldebuger.tsf
View File

@ -1336,7 +1336,7 @@ type TTslDebuga=class(TCustomControl)
if ps then
begin
psi := ps[0];
if fileexists("",psi)then
if ifstring(psi) and psi and fileexists("",psi)then
begin
cmdexe := psi;
end else
@ -1345,7 +1345,7 @@ type TTslDebuga=class(TCustomControl)
ExecuteCommand("showstr","当前指定的执行程序不存在!!");
end
psi := ps[1];
if psi and fileexists("",psi)then
if psi and ifstring(psi) and fileexists("",psi)then
begin
end else
begin
@ -1369,7 +1369,7 @@ type TTslDebuga=class(TCustomControl)
FDebugExe := cmdexe;
ExecuteCommand("showstr","<当前执行程序(F9)做调试器>");
end else
if fileexists("",FDebugExe)then
if FDebugExe and ifstring(FDebugExe) and fileexists("",FDebugExe)then
begin
ExecuteCommand("showstr","<用配置文件给定的调试器>");
end else

58
designer/utslvcldesigner.tsf
View File

@ -1000,13 +1000,69 @@ type TVclDesigner = class(tvcform)
if (wnd is class(TVCForm)) then
begin
wnd.OnMinimize := thisfunction(CompClose);
wnd.onkeydown := thisfunction(toplevelwndkeydown);
end
end
end
function get_mu_id(mus,id);
begin
for i,v in mus do
begin
if v["id"]=id then
begin
return true;
end
end
end
function toplevelwndkeydown(o,e);
begin
cd := e.CharCode;
if cd = VK_ESCAPE then return select_parent();
c := e.char;
if not((c in array("X","V","C")) or cd=VK_DELETE) then return ;
if not ((nd := fselctlnode) and (ndc := nd.Component) and (mus := ndc.menus())) then return ;
if cd = VK_DELETE then
begin
if get_mu_id(mus,"delete") then return ndc.deleteclick(nd,nil);
return ;
end
if (ssCtrl in e.shiftstate()) then
begin
case c of
"X":
begin
if get_mu_id(mus,"cut") then return ndc.cutclick(nd,nil);
end
"C":
begin
if get_mu_id(mus,"copy") then return ndc.copyclick(nd,nil);
end
"V":
begin
if get_mu_id(mus,"paste") then return ndc.pasteclick(nd,nil);
end
end ;
end
end
function isloadednode(wndnode);
begin
return fwindowinfos.getdata(wndnode);
end
function select_parent(); //ÏòÉÏÑ¡Ôñ
begin
nd := fselctlnode;
if nd then
begin
pnd := nd.parent;
if pnd and (cp :=pnd.Component) and( o := cp.Cwnd) and ifobj(o._tag) then
begin
ClickComponent(o,nil);
end
end
//TreeNodeSelected(nd.parent);
end
function UnLoadTreeNode(wndnode); //жÔؿؼþÊ÷
begin
{**
@ -1748,7 +1804,7 @@ type TDesigImageList = class(TControlImageList)
inherited;
Width := 24;
Height := 24;
DrawBimpFirst := true;
DrawBmpFirst := true;
FIconMaps := array();
end
function RegisterDitem(item);virtual;

25
designer/utslvcldesignerresource.tsf
View File

@ -59,6 +59,7 @@ function getunredobitmapinfo();
function gettslsyntaxcheckbitmapinfo();
function gettslcodemapbitmapinfo();
function getquickkeybitmapinfo();
function getbevelbitmapinfo();
function getfindbitmapinfo();
function gettslcodeformatbitmapinfo();
function getformbitmapinfo(); //´°¿Úͼ±ê
@ -1177,6 +1178,30 @@ E99858BCF1C4A7FF5D6B5F83D9D58B5F822D02B141A91006E016ECBBF4E5BF613
E69966865DDFEFF1818D12003BD1A1EFCF70526D365073F404D8400B805B40234
B6E0FF7F00E32F1D353DB8EA960000000049454E44AE42608200";
end
function getbevelbitmapinfo();
begin
return "9002000000000000000200000002000000010000009D0200003C0000000000000
004000000040000000400000008000000030000000B0000005602000074797065
64617461696D6789504E470D0A1A0A0000000D494844520000001800000018080
6000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F
0BFC6105000000097048597300000EC300000EC301C76FA864000001EB4944415
4484BBD95594EC3401044B915178003F10B3F91722BFED84212C7FBEE78B7633B
8B7385A21B3002E41921412869BE2CD52BD5F4B4CF7062FD1FE0F26685F3ABF99
F1CF61AF401E00FEBB247D51E50367B149B1DF27A8BACEA90962D92A2793D71BE
C13AAB11262582B880BFCEE14519DC30851324589AF1ABD7A02F804DD7E3783CA
2EF7B1C0E07ECF77BEC763B6CB75B745D87B66DD1340DEABA46555528CB124551
20CF736459863425882F01D4949ECD659299274902DB5B8B011555C3C95963C92
79389D43C8E63984E280694D43BD7C21AAB850132F3288A60D8811850D0A57272
D658E70C9099876108DDF2C5809C268693B3C62E940132F32008A0999E1890D13
87272169B8D1D99B9EFFB500D570C4869CE7F328A2273CFF3B0D21D3120A147F4
1B73D775A168B61810D30B95994FA7D3D1DA86E3380E96AA250644F4FC65C919C
049C792B36CDBC66265CA01B25A18C066DFCD3939CBB22CCC15430C086979C93A
1F00DFCD3939CB300C3C2F753120A0CD28BB5006C8A4EB3A660B4D0CF069ED8AC
CC76AE1E45C0B2767734DD3F03457C5008F76FA6FCC5555C5E3F3DB8F6BD01700
FF2C2C5AB7A61B41A7A5C547A3DDA2D2F35FD10B55E8112D69CE17348A739A961
9F5FD44953C52EA0732BE9F29B8BD1300FEF2977971ADBCBB7E029C4A2706002F
103EEEED1783B9280000000049454E44AE426082";
end
function getfindbitmapinfo();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746

260
designer/utslvcldpropertytypes.tsf
View File

@ -366,13 +366,17 @@ type TGridCellVariableEdit = class(TGridCellEditList,TPropertyVarible)
end ;
return v;
end
//function CellDrawLabel(dc,rect,d);override;
//begin
// dc.DrawText("(none)",rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
//end
end
type TListVariable = class(TGridList)
{**
@explan(说明) 变量选择 %%
**}
private
FOnClickSelected;
[weakref]FOnClickSelected;
public
function show(f);override;
begin
@ -394,10 +398,14 @@ type TListVariable = class(TGridList)
("text":"variable","width":180)
);
end
function SetSelectedByValue(v);override;
function SetSelectedByValue(v_);override;
begin
if ifnil(v) then return inherited;
if ifnil(v_) then return inherited;
v := v_;
vi := nil;
if ifobj(v) then v := v.name;
if ifstring(v) then
begin
for i := 0 to List.count-1 do
begin
if v=list[i].name then
@ -406,6 +414,7 @@ type TListVariable = class(TGridList)
break;
end
end
end
inherited SetSelectedByValue(vi);
end
function additem(v);override;
@ -1725,10 +1734,13 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor)
Fcpok := true;
if not(FColorChoose) then
begin
FColorChoose := new TColorChooseADlg(grid);
FColorChoose := new t_colorbox(grid);//TColorChooseADlg(grid);
FColorChoose.Parent := grid;
end
FColorChoose.Result := d["value"];
rec := GetPopRect(0);
FColorChoose.top := rec[1];
FColorChoose.left := rec[2]-400;
if FColorChoose.OpenDlg() and Fcpok then
begin
grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Result);
@ -1746,6 +1758,7 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor)
begin
Fcpok := false;
inherited;
if FColorChoose.visible then FColorChoose.EndModal(0);
end
end
type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory)
@ -1755,9 +1768,7 @@ type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory)
private
Fcpok ;
FColorChoose;
public
function create(AOwner);override;
begin
inherited;
@ -3249,6 +3260,7 @@ type TMultiSelectCell = class(TGridCellEditWithButton)
FI;
FJ;
FCellv;
FSelLock;
function GetSelPanel();virtual;
begin
if not FPanel then
@ -3267,6 +3279,7 @@ type TMultiSelectCell = class(TGridCellEditWithButton)
public
function SelChanged(o,e);
begin
if FSelLock then return ;
if fi>=0 and fj>=0 and ifarray(FCellv) then
begin
o.visible := false;
@ -3287,12 +3300,14 @@ type TMultiSelectCell = class(TGridCellEditWithButton)
fi := e.iitem;
fj := e.isubitem;
FCellv := array();
FSelLock := true;
GetSelPanel();
rec := GetPopRectByHeight(160);
rec[3] := rec[1]+160;
FPanel.SetBoundsRect(rec);
FPanel.SetSelectData(FListSel);
FPanel.Show();
FSelLock := false;
end
function CellLeave(grid);override;
begin
@ -3310,11 +3325,13 @@ type TOneSelectCell = class(TGridCellEditWithButton)
FI;
FJ;
FCellv;
FSelLock;
function GetSelPanel();virtual;
begin
if not FPanel then
begin
FPanel := new UniCheckList(Owner);
FPanel.visible := false;
FPanel.wspopup := true;
FPanel.SetList(SelPalRange());
FPanel.OnSelChanged := thisfunction(SelChanged);
@ -3325,6 +3342,7 @@ type TOneSelectCell = class(TGridCellEditWithButton)
public
function SelChanged(o,v);
begin
if FSelLock then return ;
if fi>=0 and fj>=0 and ifarray(FCellv) then
begin
o.visible := false;
@ -3341,14 +3359,17 @@ type TOneSelectCell = class(TGridCellEditWithButton)
@explan(说明) 格子点击 %%
**}
inherited;
GetSelPanel();
fi := e.iitem;
fj := e.isubitem;
FCellv := array();
GetSelPanel();
rec := GetPopRectByHeight(160);
rec[3] := rec[1]+160;
FSelLock := true;
if ifarray(d) then FPanel.SetSelValue(d["value"]);
FPanel.SetBoundsRect(rec);
FPanel.Show();
FSelLock := false;
end
end
type TGridCellAnchorsEdit = class(TMultiSelectCell,TPropertyAnchors)
@ -3420,6 +3441,119 @@ type TGridCellTabAlignEdit = class(TOneSelectCell,TPropertyTabAlign)
return SelRange;
end
end
type TGridCellTabtvestypeEdit = class(TOneSelectCell,TPropertytvetype)
{**
@explan(说明)设置expandsigntype属性%%
**}
function CellDrawLabel(dc,rect,d);override;
begin
if ifarray(d) then
begin
dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
end
end
function create(AOwner);override;
begin
inherited;
class(TPropertytvetype).Create();
end
private
function SelPalRange();virtual;
begin
return SelRange;
end
end
type TGridCelllinestyleEdit = class(TOneSelectCell,TPropertylinestyle)
{**
@explan(说明)设置expandsigntype属性%%
**}
function CellDrawLabel(dc,rect,d);override;
begin
if ifarray(d) then
begin
dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
end
end
function create(AOwner);override;
begin
inherited;
class(TPropertylinestyle).Create();
end
private
function SelPalRange();virtual;
begin
return SelRange;
end
end
type tgridcellbevelcutedit = class(TOneSelectCell,TPropertybevelcut)
{**
@explan(说明)设置beval属性%%
**}
function CellDrawLabel(dc,rect,d);override;
begin
if ifarray(d) then
begin
dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
end
end
function create(AOwner);override;
begin
inherited;
class(TPropertybevelcut).Create();
end
private
function SelPalRange();virtual;
begin
return SelRange;
end
end
type tgridcellbevelshapedit = class(TOneSelectCell,TPropertybevelshape)
{**
@explan(说明)设置bevalshape属性%%
**}
function CellDrawLabel(dc,rect,d);override;
begin
if ifarray(d) then
begin
dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
end
end
function create(AOwner);override;
begin
inherited;
class(TPropertybevelshape).Create();
end
private
function SelPalRange();virtual;
begin
return SelRange;
end
end
type tgridcellbevelstyledit = class(TOneSelectCell,TPropertybevelstyle)
{**
@explan(说明)设置bevalstyle属性%%
**}
function CellDrawLabel(dc,rect,d);override;
begin
if ifarray(d) then
begin
dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE);
end
end
function create(AOwner);override;
begin
inherited;
class(TPropertybevelstyle).Create();
end
private
function SelPalRange();virtual;
begin
return SelRange;
end
end
type TtextEditor = class(tpanel)
{**
@explan(说明)memo编辑器%%
@ -4401,6 +4535,113 @@ type TListStatusEdit2 = class(TListStatusEdit)
end
end
type t_colorbox = class(tcustomcontrol)
function create(AOwner);
begin
inherited;
caption := "color 选择";
visible := false;
WsPopUp := true;
wscaption := true;
width := 300;
height := 340;
cbox := new TColorbox(self);
for i,v in syscl() do
cbox.addColor(v["name"],v["value"]);
btok := new tbtn(self);
btcancel := new tbtn(self);
btok.caption := "确定";
btcancel.caption := "取消";
btok.parent := self;
btcancel.parent := self;
cbox.parent := self;
btok.onclick := function()begin
EndModal(1);
end
btcancel.onclick := function()begin
EndModal(0);
end
end
function OpenDlg();
begin
return showmodal();
end
function syscl();
begin
return array(
("name":"clDefault","value":0x20000000),
("name":"clScrollBar","value":-2147483648),
("name":"clBackground","value":-2147483647),
("name":"clActiveCaption","value":-2147483646),
("name":"clInactiveCaption","value":-2147483645),
("name":"clMenu","value":-2147483644),
("name":"clWindow","value":-2147483643),
("name":"clWindowFrame","value":-2147483642),
("name":"clMenuText","value":-2147483641),
("name":"clWindowText","value":-2147483640),
("name":"clCaptionText","value":-2147483639),
("name":"clActiveBorder","value":-2147483638),
("name":"clInactiveBorder","value":-2147483637),
("name":"clAppWorkspace","value":-2147483636),
("name":"clHighlight","value":-2147483635),
("name":"clHighlightText","value":-2147483634),
("name":"clBtnFace","value":-2147483633),
("name":"clBtnShadow","value":-2147483632),
("name":"clGrayText","value":-2147483631),
("name":"clBtnText","value":-2147483630),
("name":"clInactiveCaptionText","value":-2147483629),
("name":"clBtnHighlight","value":-2147483628),
("name":"cl3DDkShadow","value":-2147483627),
("name":"cl3DLight","value":-2147483626),
("name":"clInfoText","value":-2147483625),
("name":"clInfoBk","value":-2147483624),
("name":"clHotLight","value":-2147483622),
("name":"clGradientActiveCaption","value":-2147483621),
("name":"clGradientInactiveCaption","value":-2147483620),
("name":"clMenuHighlight","value":-2147483619),
("name":"clMenuBar","value":-2147483618)
//,("name":"clForm","value":-2147483617)
);
end
function DoControlAlign();override;
begin
r := clientrect;
if btok and btcancel and cbox then
begin
r1 := r;
r1[3] := r[3]-btok.height-5;
cbox.BoundsRect := r1;
t1 := r[3]-btok.height-2;
btok.top := t1;
btok.left := r[2]-btok.width-5;
btcancel.top := t1;
btcancel.left := r[2]-btok.width-10-btcancel.width;
end
end
btok;
btcancel;
property Result read get_color write set_color;
private
cbox;
function set_color(v);//
begin
itc := cbox.ItemCount;
for i:= 0 to itc-1 do
begin
if cbox.getColor(i)=v then
begin
cbox.ItemIndex := i;
return ;
end
end
cbox.customcolor := v;
cbox.ItemIndex := 0;
end
function get_color();
begin
return cbox.getColor(cbox.ItemIndex);
end
end
type TIconsEditer = class(TListEidter)
private
FFileopen;
@ -4527,7 +4768,12 @@ begin
class(TGridCellAlignEdit),
class(TGridCellAnchorsEdit),
class(TGridCellTabAlignEdit),
class(TGridCellTabtvestypeEdit),
class(tgridcellbevelcutedit),
class(tgridcellbevelstyledit),
class(tgridcellbevelshapedit),
class(TGridCellStringsEdit),
class(TGridCelllinestyleEdit),
class(TGridCellIntegersEdit),
class(TGridCellColorBoxEdit),
class(tGridCellMbbtnstyleEdit),

BIN
editor-install.exe
View File

Binary file not shown.

16
funcext/tvclib/setprocessdpiawareness.tsf Normal file
View File

@ -0,0 +1,16 @@
function setprocessdpiawareness(v);
begin
{**
@explan(˵Ã÷)ÉèÖÃdpi¸ÐÖª,Ä¿Ç°½öÖ§³Öwindows
@param(v) 0,1,2
**}
SetProcessDpiAwareness_sub(v);
end
{$ifdef linux}
function SetProcessDpiAwareness_sub(v);
begin
end
{$else}
function SetProcessDpiAwareness_sub(v:integer):pointer;stdcall; external "Shcore.dll" name "SetProcessDpiAwareness";
{$endif}

21
funcext/tvclib/t_cairo_api.tsf
View File

@ -9,6 +9,7 @@ type t_cairo_api = class()
_f_ := static function(s:pointer):pointer;cdecl;external get_cairo_func(functionname());
return ##_f_(s);
end
procedure cairo_save(c:pointer);
begin
_f_ := static procedure(c:pointer);cdecl;external get_cairo_func(functionname());
@ -24,6 +25,11 @@ type t_cairo_api = class()
_f_ := static procedure(cr:pointer;s:pointer);cdecl;external get_cairo_func(functionname());
return ##_f_(cr,s);
end
function cairo_get_target(cr:pointer):pointer;
begin
_f_ := static function(cr:pointer):pointer;cdecl;external get_cairo_func(functionname());
return ##_f_(cr);
end
function cairo_get_source(cr:pointer):pointer;
begin
_f_ := static function(cr:pointer):pointer;cdecl;external get_cairo_func(functionname());
@ -268,6 +274,11 @@ type t_cairo_api = class()
_f_ := static function(fmt:integer;w:integer;h:integer):pointer;cdecl;external get_cairo_func(functionname());
return ##_f_(fmt,w,h);
end
function cairo_surface_write_to_png(sf:pointer;fn:string):integer;
begin
_f_ := static function(sf:pointer;fn:string):integer;cdecl;external get_cairo_func(functionname());
return ##_f_(sf,fn);
end
function cairo_image_surface_create_for_data(data:string;fmt:integer;w:integer;h:integer;stride:integer):pointer;
begin
_f_ := static function(data:string;fmt:integer;w:integer;h:integer;stride:integer):pointer;cdecl;external get_cairo_func(functionname());
@ -303,6 +314,12 @@ type t_cairo_api = class()
_f_ := static function(f:string):pointer;cdecl;external get_cairo_func(functionname());
return ##_f_(f);
end
function cairo_surface_reference(sf:pointer):pointer;
begin
_f_ := static function(sf:pointer):pointer;cdecl;external get_cairo_func(functionname());
return ##_f_(sf);
end
procedure cairo_surface_destroy(sf:pointer);
begin
_f_ := static procedure(sf:pointer);cdecl;external get_cairo_func(functionname());
@ -339,9 +356,9 @@ type t_cairo_api = class()
_f_ := static function(cr:pointer):integer;cdecl;external get_cairo_func(functionname());
return ##_f_(cr);
end
procedure cairo_get_current_point(c:pointer;var x:integer;var y:integer);
procedure cairo_get_current_point(c:pointer;var x:double;var y:double);
begin
_f_ := static procedure(c:pointer;var x:integer;var y:integer);cdecl;external get_cairo_func(functionname());
_f_ := static procedure(c:pointer;var x:double;var y:double);cdecl;external get_cairo_func(functionname());
return ##_f_(c,x,y);
end
procedure cairo_new_path(c:pointer);//Clears the current path. After this call there will be no path and no current point

14
funcext/tvclib/t_gdiplusflat_api.tsf
View File

@ -43,7 +43,7 @@ type t_gdiplusflat_api=class() //gdiplus
Function GdipAddPathRectangles(path:pointer;rects:pointer;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathRectangles";
Function GdipAddPathEllipse(path:pointer;x:single;y:single;width:single;height:single):integer;stdcall;external "gdiplus.dll" name "GdipAddPathEllipse";
Function GdipAddPathPie(path:pointer;x:single;y:single;width:single;height:single;startAngle:single;sweepAngle:single):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPie";
Function GdipAddPathPolygon(path:pointer;points:pointer;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPolygon";
Function GdipAddPathPolygon(path:pointer;points:array of single;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPolygon";
Function GdipAddPathPath(path:pointer;addingPath:pointer;connect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPath";
Function GdipAddPathString(path:pointer;string:string;length:integer;family:pointer;style:integer;emSize:single;layoutRect:pointer;format:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathString";
Function GdipAddPathStringI(path:pointer;string:string;length:integer;family:pointer;style:integer;emSize:single;layoutRect:pointer;format:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathStringI";
@ -136,7 +136,7 @@ type t_gdiplusflat_api=class() //gdiplus
Function GdipTransformRegion(region:pointer;matrix:pointer):integer;stdcall;external "gdiplus.dll" name "GdipTransformRegion";
Function GdipGetRegionBounds(region:pointer;graphics:pointer;rect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionBounds";
Function GdipGetRegionBoundsI(region:pointer;graphics:pointer;rect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionBoundsI";
Function GdipGetRegionHRgn(region:pointer;graphics:pointer;hRgn:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionHRgn";
Function GdipGetRegionHRgn(region:pointer;graphics:pointer;var hRgn:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionHRgn";
Function GdipIsEmptyRegion(region:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsEmptyRegion";
Function GdipIsInfiniteRegion(region:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsInfiniteRegion";
Function GdipIsEqualRegion(region:pointer;region2:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsEqualRegion";
@ -189,7 +189,7 @@ type t_gdiplusflat_api=class() //gdiplus
//----------------------------------------------------------------------------
// LineBrush APIs
//----------------------------------------------------------------------------
Function GdipCreateLineBrush(point1:pointer;point2:pointer;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrush";
Function GdipCreateLineBrush(point1 : array of single;point2:array of single;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrush";
Function GdipCreateLineBrushI(point1:pointer;point2:pointer;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushI";
Function GdipCreateLineBrushFromRect(rect:pointer;color1:integer;color2:integer;mode:pointer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushFromRect";
Function GdipCreateLineBrushFromRectI(rect:pointer;color1:integer;color2:integer;mode:pointer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushFromRectI";
@ -221,13 +221,13 @@ type t_gdiplusflat_api=class() //gdiplus
//----------------------------------------------------------------------------
// PathGradientBrush APIs
//----------------------------------------------------------------------------
Function GdipCreatePathGradient(points:pointer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradient";
Function GdipCreatePathGradientI(points:pointer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientI";
Function GdipCreatePathGradient(points:array of single;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradient";
Function GdipCreatePathGradientI(points:array of integer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientI";
Function GdipCreatePathGradientFromPath(path:pointer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientFromPath";
Function GdipGetPathGradientCenterColor(brush:pointer;var colors:integer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientCenterColor";
Function GdipSetPathGradientCenterColor(brush:pointer;colors:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientCenterColor";
Function GdipGetPathGradientSurroundColorsWithCount(brush:pointer;var color:integer;ct:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientSurroundColorsWithCount";
Function GdipSetPathGradientSurroundColorsWithCount(brush:pointer;var color:integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientSurroundColorsWithCount";
Function GdipGetPathGradientSurroundColorsWithCount(brush:pointer;var color: array of integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientSurroundColorsWithCount";
Function GdipSetPathGradientSurroundColorsWithCount(brush:pointer;color:array of integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientSurroundColorsWithCount";
Function GdipGetPathGradientPath(brush:pointer;path:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientPath";
Function GdipSetPathGradientPath(brush:pointer;path:pointer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientPath";
Function GdipGetPathGradientCenterPoint(brush:pointer;points:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientCenterPoint";

2
funcext/tvclib/t_img_op_api.tsf
View File

@ -107,7 +107,7 @@ type t_img_op_api=class({$ifdef linux}t_cairo_api{$else}t_gdiplusflat_api{$endif
case s of
"image/png":
begin
return gdk_pixbuf_save(image,filename,"png",nil,nil,nil,nil,nil,nil)
return gdk_pixbuf_save(image,filename,"png",nil,nil,nil,nil,nil,nil);
end
"image/jpeg":
begin

2
funcext/tvclib/tcomponent.tsf
View File

@ -413,7 +413,7 @@ public //
//fondestroy := nil;
//fonnotification := nil;
end
function Destroy();virtual;
function Destroy();override;
begin
inherited;
end;

41
funcext/tvclib/tcontrol.tsf
View File

@ -20,6 +20,7 @@ type tcontrol = class(tcomponent)
FtagPAINTSTRUCT; //绘制区域
FAnchors;
fautosize;
FAnchorBounds;
FCaption;//标题
FCaptureMouseButtons;//鼠标样式
@ -177,6 +178,13 @@ type tcontrol = class(tcomponent)
FParent.DoControlAlign(); //调整位置
end
end
function setautosize(v);
begin
nv := v?true:false;
if nv=fautosize then return ;
fautosize := nv;
if nv then AdjustSize();
end
procedure SetAnchors(Value);virtual;
begin
if not ifarray(Value)then exit;
@ -359,7 +367,7 @@ type tcontrol = class(tcomponent)
end
function SetControlFont(v);virtual;
begin
if ParentFont then return ; //如果使用父节点的字体,那么字体无效
//if ParentFont and Parent then return ; //如果使用父节点的字体,那么字体无效
if ifarray(v)then
begin
FFont.SetValues(v);
@ -544,7 +552,7 @@ type tcontrol = class(tcomponent)
if NewParent=FParent then return;
if NewParent is getparenttype() then
begin
if FParent then
if FParent and (objectstate(fParent) in array(1,2,3)) then
begin
FParent.operatectrl(self(true),opRemove);
end
@ -557,7 +565,7 @@ type tcontrol = class(tcomponent)
NewParent.operatectrl(self(true),opInsert);
end else
begin
if Parent then FParent.operatectrl(self(true),opRemove);
if FParent and (objectstate(fParent) in array(1,2,3)) then FParent.operatectrl(self(true),opRemove);
end
end
procedure SetParentComponent(NewParentComponent);override; //设置父窗口
@ -853,8 +861,8 @@ type tcontrol = class(tcomponent)
//begin
SetBounds(e.left,e.top,e.width,max(2,ht));
//SetBoundsRect(array(e.left,e.top,e.width+e.left,e.top+ht));
e.top += ht;
e.height -= ht;
e.top := e.top + ht;
e.height := e.height- ht;
//end
end
alRight:
@ -874,7 +882,7 @@ type tcontrol = class(tcomponent)
begin
ht := min(e.height,bds[3]-bds[1]);
SetBounds(e.left,e.top+e.height-ht,e.width,max(ht,2));
e.height -= ht;
e.height := e.height - ht;
end
alClient:
begin
@ -1108,9 +1116,11 @@ type tcontrol = class(tcomponent)
begin
return Fid;
end
function create(Owner);override; //构造函数
function create(aOwner);override; //构造函数
begin
inherited;
FControlFlags := array();
fautosize := false;
if ifnil(FSIDC)then FSIDC := new tidcreater(100);
FId := FSIDC.createid();
//init();
@ -1122,7 +1132,7 @@ type tcontrol = class(tcomponent)
FVisible := True;
FParentBidiMode := True;
FParentColor := false;
FParentFont := false;
FParentFont := true;
//FDesktopFont := True;
FParentShowHint := True;
FIsControl := False;
@ -1408,7 +1418,7 @@ type tcontrol = class(tcomponent)
return e.Result;
end
property ActionLink read FActionLink; //write FActionLink;
{public
public
procedure AdjustSize;virtual; // smart calling DoAutoSize
begin
includestate(FControlFlags,cfAutoSizeNeeded);
@ -1416,7 +1426,15 @@ type tcontrol = class(tcomponent)
begin
Parent.AdjustSize(); //
end
end }
end
function AutoSizeDelayed();virtual;
begin
end
function AutoSizeDelayedHandle();virtual;
begin
return not(Parent);
end
protected
property UnAlignBounds read GetUnAlignBounds write SetUnAlignBounds;
{**
@ -1428,8 +1446,9 @@ type tcontrol = class(tcomponent)
published
// standard properties, which should be supported by all descendants
property Action:taction read GetAction write SetAction;
property Anchors:anchors read FAnchors write SetAnchors;
property Anchors read FAnchors write SetAnchors; //anchors 暂时屏蔽anchors
property Align:align read FAlign write SetAlign;
property autosize read fautosize write setautosize;
property ParentFont:bool read FParentFont write SetParentFont;
property Parentcolor:bool read FParentcolor write SetParentcolor;
property Caption:string read GetText write SetText ;

23
funcext/tvclib/tcustomcontrol.tsf
View File

@ -10,15 +10,16 @@ type tcustomcontrol=class(TWinControl)
procedure PaintWindow(DC:HDC);override;
begin
//odh := canvas.Handle;
Canvas.Handle := dc;
canvas.font := font;
canvas.brush.Color := Color;
Canvas.requiregdi();
Canvas.rcpaint := PAINTSTRUCT().rcpaint();
cvs := Canvas;
cvs.Handle := dc;
cvs.font := font;
cvs.brush.Color := Color;
cvs.requiregdi();
cvs.rcpaint := PAINTSTRUCT().rcpaint();
try
Paint();
finally
Canvas.Handle := 0;
cvs.Handle := 0;
end;
end
procedure Paint();override;
@ -32,6 +33,7 @@ type tcustomcontrol=class(TWinControl)
begin
fhassplitter++;
end
inherited;
end
function ControlDeleted(AControl);override;
begin
@ -71,7 +73,13 @@ type tcustomcontrol=class(TWinControl)
function DoHScroll(o,e);virtual;
begin
end
public
function DoControlAlign();override;
begin
inherited;
end
function WMVScroll(o,e):LM_VScroll;virtual;
begin
return DoVScroll(o,e);
@ -335,6 +343,9 @@ BFC6105000000097048597300000EC300000EC301C76FA8640000010D49444154
fsplitercache := nil;
end
end
private
fsplitterdragimglist;
fsplitterwilldrag;
fsplitterdraging;

16
funcext/tvclib/tcustomscrollcontrol.tsf
View File

@ -213,24 +213,24 @@ type tcustomscrollcontrol = class(TCustomControl)
// 用户点击滚动条上边的三角形
SB_LINEUP:
begin
FSI.nPos -= 1;
FSI.nPos := FSI.nPos - 1;
end
// 用户点击滚动条下边的三角形
SB_LINEDOWN:
begin
FSI.nPos += 1;
FSI.nPos := FSI.nPos + 1;
end
// 用户点击滑块上边的滚动条轴
SB_PAGEUP:
begin
//return ;
FSI.nPos -= FSI.nPage;
FSI.nPos := FSI.nPos - FSI.nPage;
end
// 用户点击滑块下边的滚动条轴
SB_PAGEDOWN:
begin
//return ;
FSI.nPos += FSI.nPage;
FSI.nPos := FSI.nPos + FSI.nPage;
end
// 用户拖动滚动条
SB_THUMBTRACK:
@ -279,22 +279,22 @@ type tcustomscrollcontrol = class(TCustomControl)
end
SB_LINELEFT:
begin
FSI.nPos -= 1;
FSI.nPos := FSI.nPos - 1;
end
// 用户点击滚动条右边的三角形
SB_LINERIGHT:
begin
FSI.nPos += 1;
FSI.nPos := FSI.nPos + 1;
end
// 用户点击滑块左边的滚动条轴
SB_PAGELEFT:
begin
FSI.nPos -= FSI.nPage;
FSI.nPos := FSI.nPos - FSI.nPage;
end
// 用户点击滑块右边的滚动条轴
SB_PAGERIGHT:
begin
FSI.nPos += FSI.nPage;
FSI.nPos := FSI.nPos + FSI.nPage;
end
// 用户拖动滚动条
SB_THUMBTRACK:

16
funcext/tvclib/tgraphiccontrol.tsf
View File

@ -102,23 +102,15 @@ type tgraphiccontrol = class(TControl)
dc := Message.wparam;
if dc then
begin
//_wapi.ReleaseDC(Canvas.Handle);
//odh := canvas.Handle;
Canvas.Handle := dc;
try
_wapi.SetViewportOrgEx(dc,FLeft,FTop,nil);
//_send_(WM_ERASEBKGND,dc,1,1);
//Perform(new tuieventbase(WM_ERASEBKGND,dc,1));
//Perform(messagecreater(nil,WM_ERASEBKGND,dc,1));
WMERASEBKGND(self(true),messagecreater(nil,WM_ERASEBKGND,dc,2));
Canvas.SaveDC();
Paint();
Canvas.RestoreDC();
//Canvas.
finally
Canvas.Handle := odh;
Canvas.Handle := 0;
end;
//Canvas.Handle := _wapi.GetDC(self.Handle);
end
end
function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
@ -137,7 +129,7 @@ type tgraphiccontrol = class(TControl)
begin
if Enabled then
cl := Color;
else cl := cl_disabled_brush;
else cl := cldisabledbk;
if ifnumber(cl)then
begin
Canvas.Brush.Color := cl;
@ -159,12 +151,11 @@ type tgraphiccontrol = class(TControl)
function Create(AOwner:TComponent);override;
begin
inherited;
//inherited Create(AOwner);
FLeft := 10;
FTop := 10;
FWidth := 80;
FHeight := 25;
ftransparent := false;
ftransparent := true;
includestate(FControlState,csCustomPaint);
end
function Recycling();override;
@ -182,6 +173,7 @@ type tgraphiccontrol = class(TControl)
InvalidateRect();
end
end
published
property OnPaint:eventhandler read FOnPaint write FOnPaint;
property transparent:bool read ftransparent write settransparent;
{**

206
funcext/tvclib/tslvcl.tsf
View File

@ -312,6 +312,8 @@ type tapplication=class(tcomponent)
fexitdolist.Push(f);
end
end
property color read getcolor write setcolor;
property font read getfont write setfont;
property Visible read FVisible write SetVisible;
property handle read FHandle;
property IfDebug read FDebug write FDebug;
@ -338,6 +340,26 @@ type tapplication=class(tcomponent)
end
fexitdolist := nil;
end
function getcolor();
begin
initialize();
return FApplicationWindow.Color;
end
function SetColor(c);
begin
initialize();
FApplicationWindow.Color := c;
end
function getfont();
begin
initialize();
return FApplicationWindow.font;
end
function Setfont(c);
begin
initialize();
FApplicationWindow.font := c;
end
end
type TLabel = class(TcustomLabel)
@ -347,12 +369,21 @@ type TLabel = class(TcustomLabel)
function create(AOwner);override;
begin
inherited;
Parentcolor := true;
end
{**
@param(TextAlign)(member of TAlignStyle9) 文字对齐 %%
**}
end
type tbevel = class(tcustombevel)
{**
@explan(说明)bevel控件 %%
**}
function create(AOwner);override;
begin
inherited;
end
end
type TWinControlWraper=class(TWinControl)
{**
@explan(说明) 包裹window句柄类,继承该类,根据CreateWnd 注释的提示重写该函数
@ -473,8 +504,10 @@ type TScrollingWinControl = class(TCustomScrollControl)
begin
continue;
end
c.Top -= dy;
c.Left -= dx;
//c.Top -= dy;
c.Top :=c.Top - dy;
//c.Left -= dx;
c.Left := c.Left - dx;
end
end
public
@ -505,6 +538,11 @@ type TPanel=class(TScrollingWinControl) //
**}
function create(AOwner);override;
begin
fborderwidth := 0;
fbevelwidth := 0;
fbevelinner := bvLowered;
fbevelouter:= bvLowered;
fbevelcolor := 0x20000000; //160,160,160
inherited;
end
function AfterConstruction();override;
@ -528,7 +566,161 @@ type TPanel=class(TScrollingWinControl) //
begin
inherited;
drawdesigninggrid();
paint_Bevel();
end
function GetClientRect();override;
begin
calc_client();
return frclient;
end
published
property borderwidth read fborderwidth write setborderwidth;
property bevelinner:tbevelcut read fbevelinner write setbevelinner;
property bevelouter:tbevelcut read fbevelouter write setbevelouter;
property bevelwidth:integer read fbevelwidth write setbevelwidth;
property bevelcolor:Color read fbevelcolor write setbevelcolor;
private //bevel
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
function paint_Bevel();
begin
if fbevelwidth<1 then return ;
cvs := Canvas;
c := fbevelcolor;
cvs.pen.Width := 1;
cvs.pen.color := c;
cvs.pen.Style := PS_SOLID;
if c .& 0x20000000 then //
begin
cc := cl3DShadow;// 0x8000000 .| COLOR_3DSHADOW ;//0xa0a0a0;
cb := cl3DLight;//0x8000000 .| COLOR_3DHILIGHT ;
if fbevelouter=bvLowered then
begin
paint_border(cvs,frobevel,fbevelwidth,cc,cb);
end else
if fbevelouter=bvRaised then
begin
paint_border(cvs,frobevel,fbevelwidth,cb,cc);
end
if fbevelinner=bvLowered then
begin
paint_border(cvs,fribevel,fbevelwidth,cc,cb);
end else
if fbevelinner=bvRaised then
begin
paint_border(cvs,fribevel,fbevelwidth,cb,cc);
end
end else
begin
cc := c;
if fbevelinner=bvLowered or fbevelinner=bvRaised then paint_border(cvs,fribevel,fbevelwidth,cc,cc);
if fbevelouter=bvLowered or fbevelouter=bvRaised then paint_border(cvs,frobevel,fbevelwidth,cc,cc);
end
end
function paint_border(cvs,rec,wd,c1,c2);
begin
cvs.pen.Color := c1;
for i := 0 to wd-1 do
begin
ps := rec_to_points( rec_inc(rec,i));
if c1=c2 then
begin
cvs.draw("polyline",ps);
end else
begin
cvs.pen.Color := c1;
cvs.moveto(ps[3]);
cvs.LineTo(ps[0]);
cvs.LineTo(ps[1]);
cvs.pen.Color := c2;
cvs.moveto(ps[1]);
cvs.LineTo(ps[2]);
cvs.LineTo(ps[3]);
end
end
end
function calc_client();//计算边框，bevel的外层
begin
frobevel := getwndclientrect();
frborder := rec_inc(frobevel,(fbevelouter<>bvNone)?fbevelwidth:0);
fribevel := rec_inc(frborder,fborderwidth);
frclient := rec_inc(fribevel,(fbevelouter<>bvNone)?fbevelwidth:0);
end
function setbevelinner(v);
begin
if v>=0 and v<=3 then
begin
nv := int(v);
if nv<>fbevelinner then
begin
fbevelinner := nv;
if fbevelwidth>1 then InvalidateRect(nil,false);
end
end
end
function setbevelouter(v);
begin
if v>=0 and v<=3 then
begin
nv := int(v);
if nv<>fbevelouter then
begin
fbevelouter := nv;
if fbevelwidth>0 then InvalidateRect(nil,false);
end
end
end
function setbevelcolor(v);
begin
if v>=0 or v<0 then
begin
nv := int(v);
if nv<>fbevelcolor then
begin
fbevelcolor := nv;
if fbevelwidth>0 then InvalidateRect(nil,false);
end
end
end
function setbevelwidth(v);
begin
if v>=0 then
begin
nv := integer(v);
if nv<30 and (fbevelwidth<>nv) then
begin
fbevelwidth := nv;
doControlALign();
end
end
end
function setborderwidth(v);
begin
if not(v>=0) then return ;
nv := integer(v);
if nv>30 then return ;
if fborderwidth<>nv then
begin
fborderwidth := nv;
DoControlAlign();
end
end
private //bevel;
fborderwidth; //////////bevel
fbevelinner;
fbevelouter;
fbevelwidth;
fbevelcolor;
/////////////////////bevel 临时变量
frobevel;
fribevel;
frborder;
frclient;
end
//托盘
type TTray=class(TComponent)
@ -1892,7 +2084,7 @@ type TColorbox=class(TcustomListBox)
fcustomcolor := nil;
arr := array(
("value":"Custom","color":nil),
("value":"None","color":nil),
("value":"None","color":0x1fffffff),
("value":"Black","color":0),
("value":"Maroon","color":128),
("value":"Green","color":32768),
@ -2009,8 +2201,10 @@ type TColorbox=class(TcustomListBox)
FitemData.splice(0,1,r);
p := parent ;
if p is class(TColorCombobox) then p.Notification(self,"customcolorchanged");
InvalidateRect(nil,false);
end
end
private
fcustomcolor;
FCdlg;
multiSel;
@ -2451,6 +2645,8 @@ type TTreeView=class(TTreeCtl)
border := true;
HasLine := true;
nodecreator := class(TTreeNode);
Border := true;
bordercolor := rgb(171,173,179);
end
function expand(item);
begin
@ -4482,6 +4678,8 @@ type tapplicationwindow=class(TWinControl)
begin
//class(TWinControl).create(AOwner);
inherited;
ParentFont := false;
Parentcolor := false;
caption := "applicationwindow";
FLeft := 0;
FTop := 0;

186
funcext/tvclib/twincontrol.tsf
View File

@ -358,6 +358,7 @@ type TWinControl = class(tcontrol)
{**
@explan(说明)初始化 %%
**}
if not _wapi then inherited;
if ifnil(FDefaultProc)then FDefaultProc := _wapi.getDefWindowProcA() ;
end
function SetBorder(v);override; //type_twinctrol
@ -444,6 +445,7 @@ type TWinControl = class(tcontrol)
begin
p.ExStyle .|= WS_EX_DLGMODALFRAME;
end
//if not fWsPopUp then p.ExStyle .|= WS_EX_LAYERED; //透明处理
if TabStop then p.Style .|= WS_TABSTOP;
//op := parent;
if not(Enabled)then p.Style .|= WS_DISABLED;
@ -755,58 +757,83 @@ type TWinControl = class(tcontrol)
function ImageChanged();virtual;
begin
end
function WMNCPAINT(o,e):LM_NCPAINT;virtual;
function ncpaint(rec);virtual;
begin
if (csDesigning in ComponentState) and FDesignSelect then
return ;
ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0));
cvs := Canvas;
cvs.moveto(ls[0]);
for i:= 1 to length(ls) do
begin
cvs.LineTo(ls[i]);
end
end
function WMNCPAINT(o,e):LM_NCPAINT;virtual;
begin
hWnd := Handle;
rec := zeros(4);
{$ifdef linux}
cvs := Canvas;
cvs.Handle := e.lparam;;
pc := cvs.pen.Color;
cvs.Pen.Color := 244;//rgb(224,0,0);
ps := cvs.Pen.Style;
pw := cvs.Pen.width;
if (csDesigning in ComponentState) and FDesignSelect then
begin
{$ifdef gtkpaint}
cvs.Handle := e.lparam;
cvs.Pen.Color := 244;//rgb(224,0,0);
cvs.Pen.Style := PS_SOLID;
cvs.Pen.width := 2;
_wapi.gtk_widget_get_allocation(hWnd,rec);
rec[0]:=0;
rec[1] := 0;
//rec[2]-=2;
//rec[3]-=2;
//cvs.FillRect(array(0,0,width,height)); //array(0,0,width,height)
rec[0]:=0;rec[1] := 0;
cvs.Draw("Polyline",array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)));
cvs.Pen.Color := pc;
cvs.Pen.width := pw;
cvs.Pen.Style := ps;
cvs.Handle := 0;
cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0;
return ;
{$endif}
_wapi.GetWindowRect(hwnd,rec);
region := new TRGNRECT();
region.Rect := rec;
if e.wparam =1 then
begin
end else
begin
_wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY);
end
if e.wparam <> 1 then _wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY);
hdc := _wapi.GetDCEx(hWnd, region.Handle, DCX_WINDOW .| DCX_CACHE .| DCX_INTERSECTRGN .| DCX_LOCKWINDOWUPDATE);
if hdc=0 then return ;
cvs := Canvas;
cvs.Handle := hdc;
cvs.Pen.Color := 244;//rgb(224,0,0);
cvs.Pen.Style := PS_SOLID;
cvs.Pen.width := 2;
defaulthandler(e);
//cvs.FillRect(array(0,0,width,height)); //array(0,0,width,height)
cvs.Draw("Polyline",array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)));
cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0;
_wapi.ReleaseDC(hWnd,hdc);
e.skip := true;
e.Result := 0;
e.skip := true;e.Result := 0;
end else
begin
if not Border then return ;
if WsCaption or WSSizebox or WSsysMenu then return ;
{$ifdef gtkpaint}
_wapi.gtk_widget_get_allocation(hWnd,rec);rec[0]:=0;rec[1] := 0;
cvs.Handle := e.lparam;
{$else}
_wapi.GetWindowRect(hwnd,rec);
region := new TRGNRECT();
region.Rect := rec;//array(rec[0]-1,rec[1],rec[2],rec[3]);
if e.wparam <> 1 then _wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY);
hdc := _wapi.GetDCEx(hWnd, region.Handle, DCX_WINDOW .| DCX_CACHE .| DCX_INTERSECTRGN .| DCX_LOCKWINDOWUPDATE);
if hdc=0 then return ;
cvs.Handle := hdc;
defaulthandler(e);
{$endif}
cvs.pen.Color := 0;
cvs.Pen.Style := PS_SOLID;
cvs.Pen.width := 1;
ncpaint(rec);
cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0;
{$ifdef gtkpaint}
{$else}
_wapi.ReleaseDC(hWnd,hdc);
{$endif}
e.skip := true;e.Result := 0;
return ;
end
end
procedure FontChanged(Sender:TObject);override;
@ -815,7 +842,7 @@ type TWinControl = class(tcontrol)
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
if it.ParentFont then
if it and it.ParentFont then
begin
it.FontChanged(sender);
end
@ -871,7 +898,7 @@ type TWinControl = class(tcontrol)
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
if it then it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
end
end
function WMSETFONT(o,e):WM_SETFONT;virtual;
@ -890,13 +917,9 @@ type TWinControl = class(tcontrol)
factivecontrol.SetFocus();
end
end
function GetClientRect();override;
function getwndclientrect();
begin
{**
@explan(说明)获得客户区大小 %%
@return(array of integer) 客户区矩形 %%
**}
ret := inherited;
ret := array(0,0,FWidth,Height);
if HandleAllocated()then
begin
if ifnumber(FClientWdith)and ifnumber(FClientHeight)then
@ -905,10 +928,16 @@ type TWinControl = class(tcontrol)
end else
_wapi.GetClientRect(self.Handle,ret);
end
//else ret := array(0,0,FClientWdith,FClientHeight);
return ret;
end
function GetClientRect();override;
begin
{**
@explan(说明)获得客户区大小 %%
@return(array of integer) 客户区矩形 %%
**}
return getwndclientrect();
end
#!begin //消息
function DoCNALIGN(o,e);override;
begin
@ -976,10 +1005,10 @@ type TWinControl = class(tcontrol)
wd := 1;
hwd := wd;
rc := new TCRect(e.lparam);
rc.top += hwd;
rc.left += wd;
rc.bottom -= wd;
rc.right -= wd;
rc.top := rc.top + hwd;
rc.left := rc.left + wd;
rc.bottom := rc.bottom - wd;
rc.right := rc.right - wd;
end
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
@ -1018,7 +1047,7 @@ type TWinControl = class(tcontrol)
cl := Color;
end else
begin
cl := cl_disabled_brush;
cl := cldisabledbk;
end
rect := array(0,0,0,0);
if e.lparam=2 then
@ -1185,7 +1214,7 @@ type TWinControl = class(tcontrol)
for i := 0 to cts.Count-1 do
begin
ci := cts[i];
if(ci is class(TWinControl))and ci.Enabled and ci.Visible and ci.TabStop and ci.HandleAllocated()then
if ci and (ci is class(TWinControl))and ci.Enabled and ci.Visible and ci.TabStop and ci.HandleAllocated()then
begin
if ci.Handle=cfoc then //找到了当前
begin
@ -1254,7 +1283,7 @@ type TWinControl = class(tcontrol)
DC := _wapi.BeginPaint(hd,ps._getptr_);
if DC=0 then exit;
try
c := ClientRect;
c := getwndclientrect() ;//ClientRect;
memdc := dc;
{$ifdef gdipaint}
mdc := _wapi.GetDC(0);
@ -1268,13 +1297,14 @@ type TWinControl = class(tcontrol)
_wapi.SetGraphicsMode(memdc,2);
{$else}
cr := ClientRect;
cr := getwndclientrect();
//rc := ps._getvalue_("rcpaint");
img := _wapi.cairo_image_surface_create(1,cr[2]-cr[0]+100,cr[3]-cr[1]+100);
img := _wapi.cairo_image_surface_create(1,cr[2]-cr[0]+1,cr[3]-cr[1]+1);
memdc := _wapi.cairo_create(img);
rcpaint := ps.rcpaint;
_wapi.gtk_object_set_data(memdc,nil);
_wapi.gtk_object_set_data(memdc,"-surface-",img);
rcpaint := ps.rcpaint;
_wapi.cairo_reset_clip(memdc);
rng := _wapi.CreateRectRgn(rcpaint[0],rcpaint[1],rcpaint[2],rcpaint[3]);
_wapi.SelectClipRgn(memdc,rng);
@ -1291,6 +1321,32 @@ type TWinControl = class(tcontrol)
{$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);
global g_save_wind;
if ifarray(g_save_wind) and g_save_wind["handle"]= hd then
begin
gsi := g_save_wind;
g_save_wind := nil;
fn := gsi["file"];
if fn and ifstring(fn) then
begin
tp := gsi["type"];
if not(tp in array("png","bmp")) then tp := "png";
if parseregexpr("\\."$tp$"$",fn,"",m,mp,ml)<>1 then fn+="."$tp;
try
ndc := _wapi.CreateCompatibleDC(memdc);
bthandle := _wapi.CreateCompatibleBitmap(memdc,c[2]-c[0],c[3]-c[1]);
oldb := _wapi.SelectObject(ndc,bthandle);
_wapi.BitBlt(ndc,0,0,c[2]-c[0],c[3]-c[1],dc,0,0,SRCCOPY);
if oldb then _wapi.SelectObject(ndc,oldb);
nmg := new tcustomimage();
nmg.FromHBitmap(bthandle);
nmg.SavetoFile(fn,tp);
finally
_wapi.DeleteDC(ndc);
_wapi.DeleteObject(bthandle);
end;
end
end
{$else}
_wapi.SelectClipRgn(memdc,0);
_wapi.cairo_set_source_surface(dc, img, 0, 0);
@ -1323,7 +1379,7 @@ type TWinControl = class(tcontrol)
for i := 0 to ctls.Count-1 do
begin
ci := ctls[i];
if ci is class(TGraphicControl)then
if ci and (ci is class(TGraphicControl))then
begin
flag := false;
break;
@ -1403,10 +1459,11 @@ type TWinControl = class(tcontrol)
protected //样式相关
function SetColor(v);override;
begin
if not ifnumber(v) then return ;
oc := color;
if oc <> v and ifnumber(v)then
begin
inherited;
if oc <> Color then
begin
if HandleAllocated()then invalidaterect(nil,false);
end
end
@ -1450,21 +1507,18 @@ type TWinControl = class(tcontrol)
begin
continue;
end
//rgb := _wapi.CreateRectRgn(itbounds[0],itbounds[1],itbounds[2],itbounds[3]); //控件区域
rgb := _wapi.CreateRectRgn(outrect[0],outrect[1],outrect[2],outrect[3]); //控件区域
//_wapi.CombineRgn(rgC,rga,rgb,RGN_AND); //控件绘画区域
//bkrg := _wapi.SelectClipRgn(TheMessage.wparam,rgc); //裁剪区域
//bkrg :=
_wapi.SelectClipRgn(TheMessage.wparam,rgb); //裁剪区域
bkrg := _wapi.SelectClipRgn(TheMessage.wparam,rgb); //裁剪区域
try
pts := it.PaintStruct();
pts._setvalue_("rcpaint",array(outrect[0]-itbounds[0],outrect[1]-itbounds[1],outrect[2]-itbounds[0],outrect[3]-itbounds[1]));
pts._setvalue_("hdc",TheMessage.wparam);
ne := new tuieventbase(LM_PAINT,TheMessage.wparam,TheMessage.lparam,TheMessage.hwnd);
_wapi.SetViewportOrgEx(TheMessage.wparam,itbounds[0],itbounds[1],nil);
it.Perform(ne);
_wapi.SetViewportOrgEx(TheMessage.wparam,c[0],c[1],nil); //恢复基准点
finally
//_wapi.SelectClipRgn(TheMessage.wparam,bkrg); //恢复区域
_wapi.SelectClipRgn(TheMessage.wparam,bkrg); //恢复区域
_wapi.DeleteObject(rgb); //销毁区域
end;
end
@ -1862,9 +1916,10 @@ type TWinControl = class(tcontrol)
while(Control is class(TWinControl)) and(Control <> Self) do Control := Control.Parent;
return Control=Self;
end
function create(owner);override; //type_twinctrol
function create(aowner);override; //type_twinctrol
begin
inherited;
//fbordercolor := rgb(190,190,190);
AfterConstruction();
if foncreated then
begin
@ -1984,7 +2039,7 @@ type TWinControl = class(tcontrol)
begin
cv := canvas;
if not(cv.HandleAllocated()) then return ;
rc := ClientRect;
rc := getwndclientrect();
dx := 20;
dy := 20;
x := 0;
@ -2009,7 +2064,7 @@ type TWinControl = class(tcontrol)
for i:= 0 to len do
begin
vi := ctls[i];
if vi is class(TWinControl) then
if vi and (vi is class(TWinControl)) then
begin
if vi.WsPopUp then continue;
if not(vi.Visible) then continue;
@ -2530,12 +2585,12 @@ type TWinControl = class(tcontrol)
e := new TMALIGN(CN_ALIGN,0,0,0);
E.left := rect[0];
e.top := rect[1];
e.width := rect[2];
e.height := rect[3];
e.width := rect[2]-rect[0];
e.height := rect[3]-rect[1];
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
if it is class(tcontrol)then
if it and (it is class(tcontrol))then
begin
//if it.Align=alNone then continue;
it.Dispatch(it,e);
@ -2593,9 +2648,13 @@ type TWinControl = class(tcontrol)
**}
for I := 0 to ControlCount-1 do
begin
Controls[I].WindowProc(e);
it := Controls[I];
if it then
begin
it.WindowProc(e);
if e.skip then Exit;
if not ifnil(e.Result)then Exit;
end
end;
end;
procedure NotifyControls(Msg); //type_twinctrol
@ -2649,6 +2708,7 @@ type TWinControl = class(tcontrol)
end
end
published //对外property
///////////////////////////////////////////////
property MinWidth:natural read FMinWidth write SetMinWidth;
property MinHeight:natural read FMinHeigt write SetMinHeight;
//property MaxWidth:integer read FMaxWidth write SetMaxWidth;

242
funcext/tvclib/ugtkinterface.tsf
View File

@ -656,6 +656,13 @@ type tsgtkapi = class(tgtkapis)
end
function GetSysColor(idx:integer):integer;
begin
cl := array(13158600,0,13743257,14405055,15790320,16777215,6579300,0,0,0,
11842740,16578548,11250603,14120960,16777215,15790320,
10526880,7171437,0,0,16777215,6908265,14935011,0,14811135,0,
13395456,15389113,15918295,16750899,15790320);
r := cl[idx];
if ifnil(r) then return 0xffffff;
return r;
if idx = 0x5 then
begin
return 0xffffff;
@ -840,8 +847,8 @@ type tsgtkapi = class(tgtkapis)
end
"rgn":
begin
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//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
@ -875,8 +882,8 @@ type tsgtkapi = class(tgtkapis)
cl := gtk_object_get_data(hdc,"text.color");
// gtk_rgb_color_rgb(cl,r,g,b);
// cairo_set_source_rgb(hdc, r, g, b);
xb := gtk_object_get_data(hdc,"viewport.x");
yb := gtk_object_get_data(hdc,"viewport.y");
xb := 0;//gtk_object_get_data(hdc,"viewport.x");
yb := 0;//gtk_object_get_data(hdc,"viewport.y");
ft := gtk_object_get_data(hdc,"font");
global gtk_gdi_object_globals;
if ft and ifarray(gtk_gdi_object_globals) then
@ -1028,10 +1035,10 @@ type tsgtkapi = class(tgtkapis)
begin
cairo_move_to(hdc,xx,yy-1);
cairo_line_to(hdc,(xx+wid*vl),yy-1);
cairo_stroke(hdc);
end
cairo_move_to(hdc,xx,yy);
cairo_show_text(hdc,TslStringToGtk(v0));
cairo_stroke(hdc);
end
return 1;
end
@ -1129,8 +1136,8 @@ type tsgtkapi = class(tgtkapis)
end
dht := max(ht-20,0)*0.08;//处理字体过大可能被覆盖的问题 20241012
cairo_save(hdc);
x := gtk_object_get_data(hdc,"viewport.x");
y := gtk_object_get_data(hdc,"viewport.y");
x := 0;//gtk_object_get_data(hdc,"viewport.x");
y := 0;//gtk_object_get_data(hdc,"viewport.y");
reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
cairo_clip_rec(hdc,reci);
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
@ -1223,8 +1230,8 @@ type tsgtkapi = class(tgtkapis)
brs := gtk_gdi_object_globals[inttostr(br)];
if not brs then return 0;
cl := brs[0].Color;
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
cairo_rectangle(dc, x+rec[0], y+rec[1], rec[2]-rec[0], rec[3]-rec[1]);
gtk_rgb_color_rgb(cl,r,g,b);
cairo_set_source_rgb(dc,r,g,b);
@ -1241,8 +1248,8 @@ type tsgtkapi = class(tgtkapis)
brs := gtk_gdi_object_globals[inttostr(br)];
if not brs then return 0;
cl := brs[0].Color;
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
cairo_rectangle(dc, x+rec[0], y+rec[1], rec[2]-rec[0], rec[3]-rec[1]);
gtk_rgb_color_rgb(cl,r,g,b);
cairo_set_source_rgb(dc,1-r,1-g,1-b);
@ -1312,12 +1319,24 @@ type tsgtkapi = class(tgtkapis)
function SetViewportOrgEx(dc:pointer;x:integer;y:integer;var pt:array of integer):integer;
begin
if not dc then return 0;
gtk_object_set_data(dc,"viewport.x",x);
gtk_object_set_data(dc,"viewport.y",y);
if not getViewportOrgEx(dc,pt) then return 0;
if pt[0]<>0 or pt[1]<>0 then
begin
cairo_translate(dc,0-pt[0],0-pt[1]);
end
cairo_translate(dc,x,y);
gtk_object_set_data(dc,"viewport.x1",x);
gtk_object_set_data(dc,"viewport.y1",y);
return 1;
end
function getViewportOrgEx(dc:pointer;var pt:array of integer):integer;
begin
if not dc then return 0;
pt := array();
pt[0] := gtk_object_get_data(dc,"viewport.x1");
pt[1] := gtk_object_get_data(dc,"viewport.y1");
return 1;
end
function DeleteObject(gdiobj :pointer);//删除gdi对象
begin
global gtk_gdi_object_globals,g_cairo_api;
@ -1398,8 +1417,8 @@ type tsgtkapi = class(tgtkapis)
end
Function MoveToEx(hdc :pointer;x:integer;y:integer;var point:array of integer):integer;
begin
xb := gtk_object_get_data(hdc,"viewport.x");
yb := gtk_object_get_data(hdc,"viewport.y");
xb := 0;//gtk_object_get_data(hdc,"viewport.x");
yb := 0;//gtk_object_get_data(hdc,"viewport.y");
//cairo_move_to(hdc,x+xb,y+yb);
xy := gtk_object_get_data(hdc,"movepointto");
if xy then
@ -1410,8 +1429,8 @@ type tsgtkapi = class(tgtkapis)
end
Function LineTo(dc :pointer;x:integer;y:integer):integer;
begin
xb := gtk_object_get_data(dc,"viewport.x");
yb := gtk_object_get_data(dc,"viewport.y");
xb := 0;//gtk_object_get_data(dc,"viewport.x");
yb := 0;//gtk_object_get_data(dc,"viewport.y");
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);
@ -1637,8 +1656,8 @@ type tsgtkapi = class(tgtkapis)
end
Function Rectangle(dc :pointer;l:integer;t:integer;r:integer;b:integer):integer;
begin
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
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);
@ -1668,31 +1687,34 @@ type tsgtkapi = class(tgtkapis)
begin
//圆心
//长度
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
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);
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
cairo_scale(dc,1,ry/rx);
cairo_applay_pen_style(dc);
cairo_move_to(dc,0,0);
cairo_arc(dc, 0, 0, rx, 0, 2 * pi());
cairo_set_brush_color(dc);
cairo_fill_preserve(dc);
cairo_set_pen_color(dc);
cairo_stroke(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
return 1;
end
Function RoundRect(dc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer;
begin
xb := gtk_object_get_data(dc,"viewport.x");
yb := gtk_object_get_data(dc,"viewport.y");
xb := 0;//gtk_object_get_data(dc,"viewport.x");
yb := 0;//gtk_object_get_data(dc,"viewport.y");
pw := gtk_object_get_data(dc,"pen.width");
if pw>0 then cairo_set_line_width(dc,pw);
@ -1707,14 +1729,15 @@ type tsgtkapi = class(tgtkapis)
end
Function Chord(hdc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer;
begin
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
pw := gtk_object_get_data(dc,"pen.width");
direct := gtk_object_get_data(dc,"arcdirection");
if pw>0 then cairo_set_line_width(dc,pw);
else cairo_set_line_width(dc,1);
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
@ -1726,6 +1749,7 @@ type tsgtkapi = class(tgtkapis)
yy2 := (nYRadial2-my);
arg1 := getargbyxy(xx1,yy1);
arg2 := getargbyxy(xx2,yy2);
cairo_move_to(dc,0,0);
if direct=2 then
begin
cairo_arc(dc, 0, 0, rx, arg1, arg2);
@ -1734,27 +1758,27 @@ type tsgtkapi = class(tgtkapis)
begin
cairo_arc(dc, 0, 0, rx, arg2, arg1);
end
cairo_set_brush_color(dc);
cairo_move_to(dc,cos(arg1)*rx,sin(arg1)*rx);
cairo_line_to(dc,cos(arg2)*rx,sin(arg2)*rx);
cairo_fill_preserve(dc);
cairo_set_pen_color(dc);
cairo_stroke(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
end
Function Pie(dc :pointer;l:integer;t:integer;r:integer;b:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer;
begin
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
pw := gtk_object_get_data(dc,"pen.width");
direct := gtk_object_get_data(dc,"arcdirection");
if pw>0 then cairo_set_line_width(dc,pw);
else cairo_set_line_width(dc,1);
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
@ -1766,6 +1790,7 @@ type tsgtkapi = class(tgtkapis)
yy2 := (nYRadial2-my);
arg1 := getargbyxy(xx1,yy1);
arg2 := getargbyxy(xx2,yy2);
cairo_move_to(dc,0,0);
if direct=2 then
begin
cairo_arc(dc, 0, 0, rx, arg1, arg2);
@ -1782,8 +1807,9 @@ type tsgtkapi = class(tgtkapis)
cairo_set_pen_color(dc);
cairo_stroke(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
end
Function SetArcDirection(dc :pointer;direct:integer):integer;
begin
@ -1832,8 +1858,8 @@ type tsgtkapi = class(tgtkapis)
//Function Arc(hdc :pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer;
Function Arc(dc :pointer;l:integer;t:integer;r:integer;b:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer;
begin
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
pw := gtk_object_get_data(dc,"pen.width");
//brc := gtk_object_get_data(dc,"brush.color");
direct := gtk_object_get_data(dc,"arcdirection");
@ -1841,6 +1867,7 @@ type tsgtkapi = class(tgtkapis)
else cairo_set_line_width(dc,1);
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
@ -1871,22 +1898,24 @@ type tsgtkapi = class(tgtkapis)
cairo_fill_preserve(dc); }
cairo_set_pen_color(dc);
cairo_stroke(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
end
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");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
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
if i = 0 then cairo_move_to(dc,Points[i,0]+x,Points[i,1]+y);
else
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);
@ -1898,8 +1927,8 @@ type tsgtkapi = class(tgtkapis)
Function PolyBezier(dc :pointer;points:array of integer;n:integer):integer;
begin
if length(points)<4 then return 0;
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
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);
@ -1920,8 +1949,8 @@ type tsgtkapi = class(tgtkapis)
Function Polyline(dc :pointer;points:array of integer;n:integer):integer;
begin
if n<2 then return ;
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
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);
@ -1929,6 +1958,8 @@ type tsgtkapi = class(tgtkapis)
cairo_applay_pen_style(dc);
for i := 0 to n-1 do
begin
if i = 0 then cairo_move_to(dc,Points[i,0]+x,Points[i,1]+y);
else
cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y);
end
cairo_stroke(dc);
@ -1953,8 +1984,8 @@ type tsgtkapi = class(tgtkapis)
DFCS_ADJUSTRECT := 0x2000;DFCS_FLAT := 0x4000;DFCS_MONO := 0x8000;
}
x := gtk_object_get_data(dc,"viewport.x");
y := gtk_object_get_data(dc,"viewport.y");
x := 0;//gtk_object_get_data(dc,"viewport.x");
y := 0;//gtk_object_get_data(dc,"viewport.y");
case dr1 of
0x4 : //DFC_BUTTON
begin
@ -2000,6 +2031,7 @@ type tsgtkapi = class(tgtkapis)
b := LPRECT[3];
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
@ -2013,8 +2045,9 @@ type tsgtkapi = class(tgtkapis)
cairo_arc(dc, 0, 0, max(rx-5,3), 0, 2 * 3.14);
cairo_set_source_rgb(dc,100/255,100/255,100/255);
cairo_fill(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
end else
if dr2 = 0x4 then // DFCS_BUTTONRADIO
begin
@ -2026,6 +2059,7 @@ type tsgtkapi = class(tgtkapis)
b := LPRECT[3];
mx := (l+r)/2+x;
my := (b+t)/2+y;
cairo_save(dc);
cairo_translate(dc,mx,my);
rx := (r-l)/2;
ry := (b-t)/2;
@ -2035,8 +2069,9 @@ type tsgtkapi = class(tgtkapis)
cairo_stroke_preserve(dc);
cairo_set_source_rgb(dc,1,1,1);
cairo_fill(dc);
cairo_scale(dc,1,rx/ry);
cairo_translate(dc,0-mx,0-my);
cairo_restore(dc);
//cairo_scale(dc,1,rx/ry);
//cairo_translate(dc,0-mx,0-my);
end else
begin
cairo_set_line_width(dc,4);
@ -2234,8 +2269,8 @@ type tsgtkapi = class(tgtkapis)
begin
global g_cairo_api;
if not hdc then return ;
xb := gtk_object_get_data(hdc,"viewport.x");
yb := gtk_object_get_data(hdc,"viewport.y");
xb := 0;//gtk_object_get_data(hdc,"viewport.x");
yb := 0;//gtk_object_get_data(hdc,"viewport.y");
img := g_cairo_api.GdipGetbmpSurface(bm);
//cairo_set_source(hdc, img);
//cairo_pattern_set_extend(cairo_get_source(hdc),1);
@ -2262,8 +2297,8 @@ type tsgtkapi = class(tgtkapis)
begin
global g_cairo_api;
if not hdc then return ;
xb := gtk_object_get_data(hdc,"viewport.x");
yb := gtk_object_get_data(hdc,"viewport.y");
xb := 0;//gtk_object_get_data(hdc,"viewport.x");
yb := 0;//gtk_object_get_data(hdc,"viewport.y");
img := g_cairo_api.GdipGetbmpSurface(bm);
if not img then return ;
x := drect[0];
@ -2271,35 +2306,49 @@ type tsgtkapi = class(tgtkapis)
p1 := (drect[2]-drect[0])/(rc[2]-rc[0]);
p2 := (drect[3]-drect[1])/(rc[3]-rc[1]);
if p1<0 or p2<0 then return 0;
cairo_save(hdc);
cairo_translate(hdc,xb+x,yb+y);
cairo_scale(hdc,p1,p2);
cairo_set_source_surface(hdc, img, 0, 0);
cairo_rectangle(hdc,0,0,rc[2]-rc[0],rc[3]-rc[1]);
if flag = 0x8800c6 or flag = 0x4 then //添加alpha处理
begin
//echo "\r\nset alopha*******+++****************";
cairo_paint_with_alpha(hdc,0.5);
cairo_set_source_rgba(hdc, 0.6, 0.6, 0.6, 0.5);
alf := 0.5;
cairo_paint_with_alpha(hdc,alf);
cairo_set_source_rgba(hdc, 0.6, 0.6, 0.6, alf);
end else
begin
//cairo_paint_with_alpha(hdc,0);
cairo_paint_with_alpha(hdc,1);
alf := gtk_object_get_data(hdc,"alpha");
if alf>0 then
begin
cairo_paint_with_alpha(hdc,(alf/255));
end else cairo_paint_with_alpha(hdc,1);
cairo_set_source_rgba(hdc, 1.0, 1.0, 1.0, 0);
end
cairo_fill(hdc);
cairo_scale(hdc,1/p1,1/p2);
cairo_translate(hdc,0-xb-x,0-yb-y);
cairo_restore(hdc);
//cairo_scale(hdc,1/p1,1/p2);
//cairo_translate(hdc,0-xb-x,0-yb-y);
end
function DrawIcon(hDC:pointer;X:integer;Y:integer;hIcon:pointer):integer;
begin
global g_cairo_api;
if not hdc then return ;
xb := gtk_object_get_data(hdc,"viewport.x");
yb := gtk_object_get_data(hdc,"viewport.y");
xb := 0;//gtk_object_get_data(hdc,"viewport.x");
yb := 0;//gtk_object_get_data(hdc,"viewport.y");
img := g_cairo_api.GdipGetbmpSurface(hIcon);
if not img then return 0;
cairo_save(hdc);
cairo_set_source_surface(hdc, img, x+xb, y+yb);
alf := gtk_object_get_data(hdc,"alpha");
if alf>0 then
begin
cairo_paint_with_alpha(hdc,(alf/255));
end else cairo_paint_with_alpha(hdc,1);
cairo_paint(hdc);
cairo_restore(hdc);
return true;
end
//////////////////////imagelist/////////////////////////////////////////////////////////////////////////
@ -3260,6 +3309,15 @@ type tmenuitemobject = class(tgtk_ctl_object) //gtk
end
end
type tgtkapis = class(t_cairo_api) //gtk对象api接口
procedure cairo_set_source_rgb(c:pointer;r:double;g:double;b:double);
begin
v := gtk_object_get_data(c,"alpha") ;
if v>0 and v<255 then
begin
return cairo_set_source_rgba(c,r,g,b,(v/255));
end
return class(t_cairo_api).cairo_set_source_rgb(c,r,g,b);
end
function gtk_object_set_data(h,n,v); //保存数据
begin
if not(h>0 or h<0) then return 0;
@ -4943,6 +5001,11 @@ type tgtkapis = class(t_cairo_api) //gtk
_f_ := static procedure(w:pointer;f:integer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w,f);
end
procedure gtk_widget_set_opacity(w:pointer;f:double);
begin
_f_ := static procedure(w:pointer;f:double);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w,f);
end
procedure gtk_window_set_transient_for(w:pointer;p:pointer);
begin
global g_applicaton_wnd_handle;
@ -5809,6 +5872,17 @@ type tgtkapis = class(t_cairo_api) //gtk
_f_ := static function():pointer; cdecl;external getfuncptrbyname(0,functionname());
return ##_f_();
end
function gdk_pixbuf_get_from_window(wd:pointer;x:integer;y:integer;w:integer;h:integer):pointer;
begin
_f_ := static function(wd:pointer;x:integer;y:integer;w:integer;h:integer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(wd,x,y,w,h);
end
function gdk_window_create_similar_surface(wd:pointer;ctx:integer;w:integer;h:integer):pointer;
begin
_f_ := static function(wd:pointer;ctx:integer;w:integer;h:integer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(wd,ctx,w,h);
end
function gdk_pixbuf_get_width(src_pixbuf:pointer):integer;
begin
_f_ := static function(src_pixbuf:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
@ -8300,7 +8374,7 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
//hd := a.handle;
//r := zeros(4);
//_wapi.gtk_widget_get_allocation(hd,r);
//cr := _wapi.gdk_cairo_create(_wapi.gtk_widget_get_window(hd));
//cr := _wapi.gdk_cairo_create(_wapi.gtk_widget_get_window(hd)); //_wapi.cairo_destroy(cr);
cr :=c;//rec := r;
rec := zeros(4); _wapi.gdk_cairo_get_clip_rectangle(cr,rec);
_Wapi.g_object_set_data(cr,nil);
@ -8316,17 +8390,18 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
_wapi.gtk_widget_get_allocation(hd,r);
if (r[2]<=(rec[0]+rec[2])) or (r[3]<=(rec[1]+rec[3])) then
begin
_wapi.gtk_object_set_data(cr,"alpha",nil);
_wapi.cairo_set_dash(cr,array(4.0,0.0),2,0);
if (FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME then
begin
_wapi.cairo_set_source_rgb(cr, 225/255, 225/255, 225/255);
_wapi.cairo_set_line_width (cr, 2);
_wapi.cairo_set_source_rgb(cr, 220, 220, 220);
_wapi.cairo_set_line_width (cr, 1.5);
_wapi.cairo_rectangle(cr,0,0,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
end
if (Fdwstyle .& _const.WS_BORDER)= _const.WS_BORDER then
begin
_wapi.cairo_set_source_rgb(cr, 100/255, 100/255, 100/255);
_wapi.cairo_set_source_rgb(cr, 210, 210, 210);
_wapi.cairo_set_line_width(cr, 0.5);
_wapi.cairo_rectangle(cr,1,1,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
@ -8334,8 +8409,26 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
CallTslVclProc(_const.WM_NCPAINT,0,cr); //绘制
end
end
//_wapi.cairo_destroy(cr);
_wapi.gtk_object_set_data(cr);
_wapi.gtk_object_set_data(cr);//Çå³ý±ê¼Ç
global g_save_wind;
if not ifarray(g_save_wind) then return ;
if g_save_wind["handle"] <> hwd then return ;
gsi := g_save_wind;
g_save_wind := nil;
fn := gsi["file"];
if not(fn and ifstring(fn)) then return ;
fn := ansitoutf8(fn);
r := zeros(4);
hd := a.handle;
_wapi.gtk_widget_get_allocation(hd,r);
gwd := _wapi.gtk_widget_get_window(hd);
pix := _wapi.gdk_pixbuf_get_from_window(gwd,r[0],r[1],r[2],r[3]);
tp := gsi["type"];
if not(tp in array("png","bmp")) then tp := "png";
if parseregexpr("\\."$tp$"$",fn,"",m,mp,ml)<>1 then fn+="."$tp;
gdk_pixbuf_save(pix,fn,tp,nil,nil,nil,nil,nil,nil);
end;
function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);override;
begin
@ -8817,6 +8910,11 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
FVBardown; //滚动条按下
FHBardown;
FScroller;
function gdk_pixbuf_save(pixbuf:pointer;p:string;tp:string;gerr:string;p1:string; p2:string;p3:string;p4:string;p5:string):integer;
begin
_f_ := static function(pixbuf:pointer;p:string;tp:string;gerr:string;p1:string; p2:string;p3:string;p4:string;p5:string):integer;cdecl;external getdlsymaddress("libgtk-3.so.0",functionname());
return ##_f_(pixbuf,p,tp,gerr,p1,p2,p3,p4,p5);
end
end
type tgtk_ctl_object_client = class(tgtk_ctl_object)

20
funcext/tvclib/utslmemo.tsf
View File

@ -492,7 +492,6 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
FGutterCharCount; //gutter 字符个数
Fautogutterwidth; //自动设置gutter宽度
FGutter; //gutter
FMarginTop;
FLines;
fLastCaretY; //最新y位置
//fCaretLineNeedPaint;
@ -537,11 +536,13 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end}
function GetClientXCapacity();override; //宽度容量
begin
return integer(ClientRect[2]/GetXScrollDelta());
c := ClientRect;
return integer((c[2]-c[0])/GetXScrollDelta());
end
function GetClientYCapacity();override; //高度容量
begin
return integer(ClientRect[3]/GetYScrollDelta());
c := ClientRect;
return integer((c[3]-c[1])/GetYScrollDelta());
end
function GetClientXCount();override; //宽度间隔
begin
@ -585,8 +586,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
ps := PAINTSTRUCT().rcPaint;
tp := ps[1];
bo := ps[3];
FirstLine := integer(max(0,yPos+(tp-FMarginTop)/GetYScrollDelta()));
LastLine := integer(min(FLines.Length()-1,yPos+(bo-FMarginTop)/GetYScrollDelta()));
FirstLine := integer(max(0,yPos+(tp)/GetYScrollDelta()));
LastLine := integer(min(FLines.Length()-1,yPos+(bo)/GetYScrollDelta()));
if FGutterCharCount>0 and(ps[0]<FGutter.Width)then
begin
rc := ps;
@ -606,6 +607,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
PaintTextLines(RC,FirstLine,LastLine,FirstCol,LastCol);
end
PluginsAfterPaint(self.Canvas,ps,FirstLine,LastLine);
inherited;
end
function PaintGutter(rcDraw,nL1,nL2);
begin
@ -960,7 +962,6 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
fLinesInWindow := integer((rc[3]-rc[1])/fTextHeight);
FTopLine := 1;
FLeftChar := 1;
FMarginTop := 0;
fCaretX := 1;
fCaretY := 1;
FSetPostioned := 0;
@ -969,6 +970,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
//*********************************
fUndoList := new TTslMenoUndoList();
fRedoList := new TTslMenoUndoList();
ParentFont := false;
end
function ClipCursor(); //固定光标区域
@ -1602,9 +1604,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
function FontChanged(o);override;
begin
inherited;
FCharWidth := Font.width;
ft := Font;
if not FGutter then return ;
FCharWidth := ft.width;
FGutter.Width := (5*(FGutterCharCount>0))+FGutterCharCount * FCharWidth+1;
FCharHeight := Font.Height;
FCharHeight := ft.Height;
fTextHeight := FCharHeight+FLineInterval;
ReCreateCaret();
UpDateScroll();

12
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -52,6 +52,7 @@ function TS_GetAppPath():string;
function TS_GetIniPath(t:integer;iname:string):string;
function gettslexefullpath();
function int_to_binary(d,n); //整数转换成字符串
function rec_inc(rec,n); //挑战区域大小
//function tsl_str_head_at(s,n);
function get_tsl_mem_ptr(s,n);
type tuiglobaldata=class() //全局对象存储
@ -4154,6 +4155,17 @@ begin
end
return r;
end
function rec_inc(rec,n);
begin
r := rec;
r[0]+=n;
r[1]+=n;
r[2]-=n;
r[3]-=n;
if r[2]<r[0] then r[2] := r[0];
if r[3]<r[1] then r[3] := r[1];
return r;
end
function istextascii(s); //ansi编码
begin
len := length(s);

43
funcext/tvclib/utslvclbase.tsf
View File

@ -58,9 +58,12 @@ uses uwindowsinterface;
function getpathbyprocid(id);
begin
{**
@explan(说明) 获取所有进程路径 %%
@explan(说明) 获取所有进程路径,仅支持windows %%
@param(id)(integer) 进程id
**}
{$ifdef linux}
return "";
{$endif }
strFilePath := "";
len := 1024;
setlength(strFilePath,len);
@ -80,27 +83,32 @@ uses uwindowsinterface;
function EnumProcesses();
begin
{**
@explan(说明) 获取所有进程id
@explan(说明) 获取所有进程id，仅支持windows
**}
{**
@example(获取所有进程id,并获得路径)
t := EnumProcesses();
for i,v in t do echo getpathbyprocid(v),"\r\n";
**}
{$ifdef linux}
return "";
{$endif }
ret := zeros(2048);
EnumProcesses_(ret,length(ret)* 4,t);
r := "";
if t>0 then r := ret[0:t/4];
return r;
end
function Toolhelp32Snapshot();
begin
{**
@explan(说明) 获取所有进程信息 %%
@explan(说明) 获取所有进程信息，仅支持windows %%
@param()
@return(array) 进程信息 %%
**}
{$ifdef linux}
return array();
{$endif }
currentProcess := new Ttagprocessentry32();
hProcess := CreateToolhelp32Snapshot(2,0); //给系统内的所有进程拍一个快照
r := array();
@ -120,8 +128,11 @@ uses uwindowsinterface;
function Toolhelp32Snapshotmodule(id);
begin
{**
@explan(说明) 获取所有module信息
@explan(说明) 获取所有module信息，仅支持windows
**}
{$ifdef linux}
return array();
{$endif }
if not(id >= 0)then id := 0;
currentProcess := new TtagMODULEENTRY32();
hProcess := CreateToolhelp32Snapshot(8,id); //给系统内的所有进程拍一个快照
@ -140,6 +151,9 @@ uses uwindowsinterface;
end
function Comctl32version(); //获取comctl32.dll版本
begin
{$ifdef linux}
return array();
{$endif }
o := tslcstructure(array(
("cbsize","int",0),
("dwmajorversion","int",0),
@ -152,6 +166,9 @@ uses uwindowsinterface;
end
function shell32Version(); //获取shell32.dll版本
begin
{$ifdef linux}
return array();
{$endif }
o := tslcstructure(array(
("cbsize","int",0),
("dwmajorversion","int",0),
@ -196,7 +213,6 @@ type TSLUIBASE=class(TSLUICONST) //ͼ
@explan(说明)图像库基类,提供基本的底层操作和常量 %%
**}
private
static const TSLRCS_NONE = 0;
static const TSLRCS_BEGIN = 1;
static const TSLRCS_END = 2;
@ -227,11 +243,13 @@ type TSLUIBASE=class(TSLUICONST) //ͼ
{**
@explan(说明)初始化win32接口对象_wapi
**}
if not(_wapi)then
if not(_wapi is class(tswin32api))then
begin
global G_O_TSWIN32API_;
if not G_O_TSWIN32API_ then G_O_TSWIN32API_ := new tswin32api();
_wapi := G_O_TSWIN32API_;
if not FTSLkeyWordshash then
begin
FTSLkeyWords := TSL_ReservedKeys2();
FTSLkeyWordshash := array();
for i,v in FTSLkeyWords do
@ -239,18 +257,19 @@ type TSLUIBASE=class(TSLUICONST) //ͼ
FTSLkeyWordshash[v] := true;
end
end
end
if not FHAPP then
begin
FHAPP := _wapi.GetModuleHandleA(0);
end
end
class Function isKeyWords(key);
class Function isKeyWords(k);
begin
{**
@explan(说明) 判断是否为tsl关键字 %%
@param(key)(string)
@param(k)(string)
**}
return ifstring(key)and ifarray(FTSLkeyWordshash) and( FTSLkeyWordshash[lowercase(key)]);
return ifstring(k)and ifarray(FTSLkeyWordshash) and( FTSLkeyWordshash[lowercase(k)]);
return false;
end
@ -406,10 +425,6 @@ type TWMNCHITTEST=class(TSLUICONST) // hittest
return 0;
end
end
implementation
initialization
end.

49
funcext/tvclib/utslvclcef.tsf
View File

@ -24,6 +24,11 @@ type tcefowner = class(tcustomcontrol)
finitcef := true;
sinit();
fcefloop := new tcefproc();
fcefapp.on_before_command_line_processing := function(o,u,cmd)
begin
//cmd.set_program(%% D:\Program Files\Tinysoft\AnalyseNG.NET\tsl_cef_main.exe%%);
cmd.append_argument("single-process");
end
app := initializeapplication();
app.addExitMessageLoopdo(thisfunction(cef_shutdown));
cef_initialize(fargs._getptr_(), fappsetting._getptr_(), fcefapp._getptr_(),0);
@ -107,7 +112,7 @@ type tcefowner = class(tcustomcontrol)
muh := new cef_context_menu_handler_t();
muh.on_before_context_menu := function(o,b,f,pms,d)begin
ppm := PopupMenu;
if d then d.remove(132);
if d then d.remove(0x84);
if ppm then
begin
fpopupmenushine := array();
@ -126,9 +131,10 @@ type tcefowner = class(tcustomcontrol)
return 1;
end
end
fclient.context_menu_handler := muh;
fclient.download_handler := d;
//fclient.context_menu_handler := muh;
//fclient.download_handler := d;
fbrssetting := new cef_browser_settings_t();
ftimer := new TTimer(self);
end
function checknewchild(c);override;
begin
@ -243,20 +249,22 @@ type tcefowner = class(tcustomcontrol)
end
end
published
property client read fclient;
property appsetting read getappsetting;
property url:string read furl write seturl;
property oncandownload:eventhandler read FOncandownload write FOncandownload;
property Ondownloadupdate:eventhandler read FOndownloadupdate write fOndownloadupdate;
private
function seturl(url); //ÉèÖÃurl
function seturl(u); //ÉèÖÃurl
begin
if furl<>url then
if furl<>u then
begin
furl := url;
furl := u;
if HandleAllocated() then
begin
if fbrower and (fm := fbrower.get_main_frame()) then
if fbrower {and (fm := fbrower.get_main_frame())} then
begin
fm.load_url(url);
add_lazy_load();
end else
begin
initbrowser();
@ -277,9 +285,26 @@ type tcefowner = class(tcustomcontrol)
fwinfo.bounds.y := r[1];
fwinfo.bounds.width := r[2];
fwinfo.bounds.height := r[3];
fbrower := cef_browser_host_create_browser_sync_tsl(fwinfo, fclient,furl, fbrssetting, 0, 0);
fbrower := cef_browser_host_create_browser_sync_tsl(fwinfo, fclient,"", fbrssetting, 0, 0);
add_lazy_load();
end
end
function lazy_load();
begin
if not fneedload then return ;
if fbrower then
begin
fm := fbrower.get_main_frame();
if fm then
fm.load_url(furl);
fneedload := false;
end
end
function add_lazy_load();
begin
fneedload := true;
ftimer.timeout(thisfunction(lazy_load()),60);
end
function createusrmenu(mu,d,idx); //构造菜单映射
begin
if not mu then return ;//
@ -344,6 +369,8 @@ type tcefowner = class(tcustomcontrol)
fwinfo;
fbrssetting;
fhandlebk;
ftimer;
fneedload;
class function tslpath(); //tsl.exe 目录
begin
p := pluginpath();
@ -354,6 +381,10 @@ type tcefowner = class(tcustomcontrol)
end
return p;
end
function getappsetting();
begin
return fappsetting;
end
end
type tcandownevent = class(tuieventbase) //是否可以下载
function create(m,w,l,h);override;

1695
funcext/tvclib/utslvclcefinterface.tsf
View File

File diff suppressed because it is too large Load Diff

446
funcext/tvclib/utslvclconstant.tsf
View File

@ -145,6 +145,20 @@ type TDockOrientation=class()
static const doNoOrient=0x0;static const doHorizontal=0x1;
static const doVertical=0x2;static const doPages=0x3;
end
type tbevelstyle = class()
static const bsLowered=0x0;static const bsRaised=0x1;
end
type tbevelshape = class()
static const bsbox=0x0;
static const bsframe=0x1;
static const bsTopLine=2; static const bsBottomLine=3;
static const bsLeftLine=4;static const bsRightLine=5;static const bsSpacer=6;
end
type tbevelcut = class()
static const bvNone=0x0;
static const bvLowered=0x1;
static const bvRaised=0x2;static const bvSpace=0x3;
end
type TDragKind=class()
static const dkDrag=0x0;static const dkDock=0x1;
end
@ -385,7 +399,13 @@ type TSystemBitmap=class
static OBM_OLD_ZOOM;
static OBM_OLD_RESTORE;
end
type tvexpandsigntype = class()
static const tvestTheme = 0; // use themed sign
static const tvestPlusMinus=1; // use +/- sign
static const tvestArrow=2; // use blank arrow
static const tvestArrowFill=3; // use filled arrow
//tvestAngleBracket // use > symbol
end
type TSystemCursor=class
{**
@explan(说明) 鼠标常量类,作为参考ocr_ 开头 %%
@ -411,17 +431,16 @@ type TSystemCursor=class
static OCR_APPSTARTING; //126
static OCR_IBEAM; //152
end
type tmacroconst=class(_commctrldef_,_tvclmsageid_,_shellapi_,_gdiflatconst_)
type tmacroconst=class(_commctrldef_,_tvclmsageid_,_shellapi_)
//static const tmacroconstinit=0x1;
end
type tconstant=class(talign,TAnchorKind,TFormStyle,TComponentState,TComponentStyle,TWinControlFlag,TControlStyleType,TMouseButton,TShiftStateEnum,TControlFlag,TDockOrientation,TDragKind,TDragMode,TDragState,TDragMessage,TCanvasStates,TFPPenMode,TFPPenEndCap,TFPPenJoinStyle,TControlStateType,TFormBorderStyle,TAlignStyle9,TAlignStyleH3,TSysCursor,TActionListState,TToolButtonStyle,TPairSplitterType)
type tconstant=class(tvexpandsigntype,talign,TAnchorKind,TFormStyle,TComponentState,TComponentStyle,TWinControlFlag,TControlStyleType,TMouseButton,TShiftStateEnum,TControlFlag,TDockOrientation,tbevelcut,tbevelstyle,tbevelshape,TDragKind,TDragMode,TDragState,TDragMessage,TCanvasStates,TFPPenMode,TFPPenEndCap,TFPPenJoinStyle,TControlStateType,TFormBorderStyle,TAlignStyle9,TAlignStyleH3,TSysCursor,TActionListState,TToolButtonStyle,TPairSplitterType)
end
type TSLUICONST=class(tmacroconst,tconstant)
static const WM_TRAY=0x464;static const opInsert="opInsert+";
static const opRemove="opRemove-";static const opRecycling="opRecycling-";static const opclosemainwnd="~closemianwnd~";
static const cl_disabled_pen=0xafafaf;static const cl_disabled_brush=0xf9f9f9;
end
type ws2def_h=class()
static const AF_UNSPEC=0x0;static const AF_UNIX=0x1;
@ -1130,7 +1149,85 @@ type _gdi_h_=class()
static const WGL_SWAP_UNDERLAY13=0x10000000;static const WGL_SWAP_UNDERLAY14=0x20000000;static const WGL_SWAP_UNDERLAY15=0x40000000;
static const WGL_SWAPMULTIPLE_MAX=0x10;
end
type _winuserdef_=class()
type t_sys_color_v = class()
static const SYS_COLOR_BASE = 0x80000000;
static const COLOR_SCROLLBAR=0x0;
static const COLOR_BACKGROUND=0x1;static const COLOR_ACTIVECAPTION=0x2;static const COLOR_INACTIVECAPTION=0x3;
static const COLOR_MENU=0x4;static const COLOR_WINDOW=0x5;static const COLOR_WINDOWFRAME=0x6;
static const COLOR_MENUTEXT=0x7;static const COLOR_WINDOWTEXT=0x8;static const COLOR_CAPTIONTEXT=0x9;
static const COLOR_ACTIVEBORDER=0xA;static const COLOR_INACTIVEBORDER=0xB;static const COLOR_APPWORKSPACE=0xC;
static const COLOR_HIGHLIGHT=0xD;static const COLOR_HIGHLIGHTTEXT=0xE;static const COLOR_BTNFACE=0xF;
static const COLOR_BTNSHADOW=0x10;static const COLOR_GRAYTEXT=0x11;static const COLOR_BTNTEXT=0x12;
static const COLOR_INACTIVECAPTIONTEXT=0x13;static const COLOR_BTNHIGHLIGHT=0x14;static const COLOR_3DDKSHADOW=0x15;
static const COLOR_3DLIGHT=0x16;static const COLOR_INFOTEXT=0x17;static const COLOR_INFOBK=0x18;
static const COLOR_HOTLIGHT=0x1A;static const COLOR_GRADIENTACTIVECAPTION=0x1B;static const COLOR_GRADIENTINACTIVECAPTION=0x1C;
static const COLOR_MENUHILIGHT=0x1D;static const COLOR_MENUBAR=0x1E;static const COLOR_DESKTOP=0x1;
static const COLOR_3DFACE=0xF;static const COLOR_3DSHADOW=0x10;static const COLOR_3DHIGHLIGHT=0x14;
static const COLOR_3DHILIGHT=0x14;static const COLOR_BTNHILIGHT=0x14;
static const clNone=0x1FFFFFFF;static const clDefault=0x20000000;
static const clScrollBar = SYS_COLOR_BASE .| COLOR_SCROLLBAR;
static const clBackground = SYS_COLOR_BASE .| COLOR_BACKGROUND;
static const clActiveCaption = SYS_COLOR_BASE .| COLOR_ACTIVECAPTION;
static const clInactiveCaption = SYS_COLOR_BASE .| COLOR_INACTIVECAPTION;
static const clMenu = SYS_COLOR_BASE .| COLOR_MENU;
static const clWindow = SYS_COLOR_BASE .| COLOR_WINDOW;
static const clWindowFrame = SYS_COLOR_BASE .| COLOR_WINDOWFRAME;
static const clMenuText = SYS_COLOR_BASE .| COLOR_MENUTEXT;
static const clWindowText = SYS_COLOR_BASE .| COLOR_WINDOWTEXT;
static const clCaptionText = SYS_COLOR_BASE .| COLOR_CAPTIONTEXT;
static const clActiveBorder = SYS_COLOR_BASE .| COLOR_ACTIVEBORDER;
static const clInactiveBorder = SYS_COLOR_BASE .| COLOR_INACTIVEBORDER;
static const clAppWorkspace = SYS_COLOR_BASE .| COLOR_APPWORKSPACE;
static const clHighlight = SYS_COLOR_BASE .| COLOR_HIGHLIGHT;
static const clHighlightText = SYS_COLOR_BASE .| COLOR_HIGHLIGHTTEXT;
static const clBtnFace = SYS_COLOR_BASE .| COLOR_BTNFACE;
static const clBtnShadow = SYS_COLOR_BASE .| COLOR_BTNSHADOW;
static const clGrayText = SYS_COLOR_BASE .| COLOR_GRAYTEXT;
static const clBtnText = SYS_COLOR_BASE .| COLOR_BTNTEXT;
static const clInactiveCaptionText = SYS_COLOR_BASE .| COLOR_INACTIVECAPTIONTEXT;
static const clBtnHighlight = SYS_COLOR_BASE .| COLOR_BTNHIGHLIGHT;
static const cl3DDkShadow = SYS_COLOR_BASE .| COLOR_3DDKSHADOW;
static const cl3DLight = SYS_COLOR_BASE .| COLOR_3DLIGHT;
static const clInfoText = SYS_COLOR_BASE .| COLOR_INFOTEXT;
static const clInfoBk = SYS_COLOR_BASE .| COLOR_INFOBK;
static const clHotLight = SYS_COLOR_BASE .| COLOR_HOTLIGHT;
static const clGradientActiveCaption = SYS_COLOR_BASE .| COLOR_GRADIENTACTIVECAPTION;
static const clGradientInactiveCaption = SYS_COLOR_BASE .| COLOR_GRADIENTINACTIVECAPTION;
static const clMenuHighlight = SYS_COLOR_BASE .| COLOR_MENUHILIGHT;
static const clMenuBar = SYS_COLOR_BASE .| COLOR_MENUBAR;
static const clColorDesktop = SYS_COLOR_BASE .| COLOR_DESKTOP;
static const cl3DFace = SYS_COLOR_BASE .| COLOR_3DFACE;
static const cl3DShadow = SYS_COLOR_BASE .| COLOR_3DSHADOW;
static const cl3DHiLight = SYS_COLOR_BASE .| COLOR_3DHIGHLIGHT;
static const clBtnHiLight = SYS_COLOR_BASE .| COLOR_BTNHILIGHT;
static const clFirstSpecialColor = clBtnHiLight;
static const cldisabledtext=0xafafaf;static const cldisabledbk=0xf9f9f9;
// standard colors
static const clBlack = 0x000000;
static const clMaroon = 0x000080;
static const clGreen = 0x008000;
static const clOlive = 0x008080;
static const clNavy = 0x800000;
static const clPurple = 0x800080;
static const clTeal = 0x808000;
static const clGray = 0x808080;
static const clSilver = 0xC0C0C0;
static const clRed = 0x0000FF;
static const clLime = 0x00FF00;
static const clYellow = 0x00FFFF;
static const clBlue = 0xFF0000;
static const clFuchsia = 0xFF00FF;
static const clAqua = 0xFFFF00;
static const clLtGray = 0xC0C0C0; // clSilver alias
static const clDkGray = 0x808080; // clGray alias
static const clWhite = 0xFFFFFF;
static const clMoneyGreen = 0xC0DCC0;
static const clSkyBlue = 0xF0CAA6;
static const clCream = 0xF0FBFF;
static const clMedGray = 0xA4A0A0;
end
type _winuserdef_=class(t_sys_color_v)
static const WINUSERAPI=0x0;static const WINABLEAPI=0x0;
static const WINVER=0x500;static const MAKEINTRESOURCE=0x0;static const DIFFERENCE=0xB;
static const RT_MANIFEST=0x18;static const CREATEPROCESS_MANIFEST_RESOURCE_ID=0x1;static const ISOLATIONAWARE_MANIFEST_RESOURCE_ID=0x2;
@ -1678,19 +1775,7 @@ type _winuserdef_=class()
static const CWP_SKIPINVISIBLE=0x1;static const CWP_SKIPDISABLED=0x2;static const CWP_SKIPTRANSPARENT=0x4;
static const CTLCOLOR_MSGBOX=0x0;static const CTLCOLOR_EDIT=0x1;static const CTLCOLOR_LISTBOX=0x2;
static const CTLCOLOR_BTN=0x3;static const CTLCOLOR_DLG=0x4;static const CTLCOLOR_SCROLLBAR=0x5;
static const CTLCOLOR_STATIC=0x6;static const CTLCOLOR_MAX=0x7;static const COLOR_SCROLLBAR=0x0;
static const COLOR_BACKGROUND=0x1;static const COLOR_ACTIVECAPTION=0x2;static const COLOR_INACTIVECAPTION=0x3;
static const COLOR_MENU=0x4;static const COLOR_WINDOW=0x5;static const COLOR_WINDOWFRAME=0x6;
static const COLOR_MENUTEXT=0x7;static const COLOR_WINDOWTEXT=0x8;static const COLOR_CAPTIONTEXT=0x9;
static const COLOR_ACTIVEBORDER=0xA;static const COLOR_INACTIVEBORDER=0xB;static const COLOR_APPWORKSPACE=0xC;
static const COLOR_HIGHLIGHT=0xD;static const COLOR_HIGHLIGHTTEXT=0xE;static const COLOR_BTNFACE=0xF;
static const COLOR_BTNSHADOW=0x10;static const COLOR_GRAYTEXT=0x11;static const COLOR_BTNTEXT=0x12;
static const COLOR_INACTIVECAPTIONTEXT=0x13;static const COLOR_BTNHIGHLIGHT=0x14;static const COLOR_3DDKSHADOW=0x15;
static const COLOR_3DLIGHT=0x16;static const COLOR_INFOTEXT=0x17;static const COLOR_INFOBK=0x18;
static const COLOR_HOTLIGHT=0x1A;static const COLOR_GRADIENTACTIVECAPTION=0x1B;static const COLOR_GRADIENTINACTIVECAPTION=0x1C;
static const COLOR_MENUHILIGHT=0x1D;static const COLOR_MENUBAR=0x1E;static const COLOR_DESKTOP=0x1;
static const COLOR_3DFACE=0xF;static const COLOR_3DSHADOW=0x10;static const COLOR_3DHIGHLIGHT=0x14;
static const COLOR_3DHILIGHT=0x14;static const COLOR_BTNHILIGHT=0x14;static const GETWINDOWLONG=0x0;
static const CTLCOLOR_STATIC=0x6;static const CTLCOLOR_MAX=0x7;static const GETWINDOWLONG=0x0;
static const SETWINDOWLONG=0x0;static const GETWINDOWLONGPTR=0x0;static const SETWINDOWLONGPTR=0x0;
static const GETCLASSLONG=0x0;static const SETCLASSLONG=0x0;static const GETCLASSLONGPTR=0x0;
static const SETCLASSLONGPTR=0x0;static const FINDWINDOW=0x0;static const FINDWINDOWEX=0x0;
@ -3145,331 +3230,6 @@ type _shellapi_=class()
static const shil_last=0x4;static const wc_netaddress="msctls_netaddress";static const ncm_getaddress=0x401;
static const ncm_setallowtype=0x402;static const ncm_getallowtype=0x403;static const ncm_displayerrortip=0x404;
end
type _gdiflatconst_ = class() //gdiplusflat
//FillMode
static const FillModeAlternate = 0;
static const FillModeWinding = 1;
//QualityMode
static const QualityModeInvalid = -1;
static const QualityModeDefault = 0;
static const QualityModeLow = 1;
static const QualityModeHigh = 2;
//CompositingMode
static const CompositingModeSourceOver = 0;
static const CompositingModeSourceCopy = 1;
//CompositingQuality
static const CompositingQualityInvalid = QualityModeInvalid;
static const CompositingQualityDefault = QualityModeDefault;
static const CompositingQualityHighSpeed = QualityModeLow;
static const CompositingQualityHighQuality = QualityModeHigh;
static const CompositingQualityGammaCorrected = 3;
static const CompositingQualityAssumeLinear = 4;
//Unit
static const UnitWorld = 0;
static const UnitDisplay = 1;
static const UnitPixel = 2;
static const UnitPoint = 3;
static const UnitInch = 4;
static const UnitDocument = 5;
static const UnitMillimeter = 6;
//MetafileFrameUnit
static const MetafileFrameUnitPixel = UnitPixel;
static const MetafileFrameUnitPoint = UnitPoint;
static const MetafileFrameUnitInch = UnitInch;
static const MetafileFrameUnitDocument = UnitDocument;
static const MetafileFrameUnitMillimeter = UnitMillimeter;
static const MetafileFrameUnitGdi = 7;
///CoordinateSpace
static const CoordinateSpaceWorld = 0;
static const CoordinateSpacePage = 1;
static const CoordinateSpaceDevice = 2;
//////WrapMode///////
static const WrapModeTile = 0;
static const WrapModeTileFlipX = 1;
static const WrapModeTileFlipY = 2;
static const WrapModeTileFlipXY = 3;
static const WrapModeClamp = 4;
///////HatchStyle//////////////////
static const HatchStyleHorizontal = 0 ;
static const HatchStyleVertical = 1 ;
static const HatchStyleForwardDiagonal = 2 ;
static const HatchStyleBackwardDiagonal = 3 ;
static const HatchStyleCross = 4 ;
static const HatchStyleDiagonalCross = 5 ;
static const HatchStyle05Percent = 6 ;
static const HatchStyle10Percent = 7 ;
static const HatchStyle20Percent = 8 ;
static const HatchStyle25Percent = 9 ;
static const HatchStyle30Percent = 10;
static const HatchStyle40Percent = 11;
static const HatchStyle50Percent = 12;
static const HatchStyle60Percent = 13;
static const HatchStyle70Percent = 14;
static const HatchStyle75Percent = 15;
static const HatchStyle80Percent = 16;
static const HatchStyle90Percent = 17;
static const HatchStyleLightDownwardDiagonal = 18;
static const HatchStyleLightUpwardDiagonal = 19;
static const HatchStyleDarkDownwardDiagonal = 20;
static const HatchStyleDarkUpwardDiagonal = 21;
static const HatchStyleWideDownwardDiagonal = 22;
static const HatchStyleWideUpwardDiagonal = 23;
static const HatchStyleLightVertical = 24;
static const HatchStyleLightHorizontal = 25;
static const HatchStyleNarrowVertical = 26;
static const HatchStyleNarrowHorizontal = 27;
static const HatchStyleDarkVertical = 28;
static const HatchStyleDarkHorizontal = 29;
static const HatchStyleDashedDownwardDiagonal = 30;
static const HatchStyleDashedUpwardDiagonal = 31;
static const HatchStyleDashedHorizontal = 32;
static const HatchStyleDashedVertical = 33;
static const HatchStyleSmallConfetti = 34;
static const HatchStyleLargeConfetti = 35;
static const HatchStyleZigZag = 36;
static const HatchStyleWave = 37;
static const HatchStyleDiagonalBrick = 38;
static const HatchStyleHorizontalBrick = 39;
static const HatchStyleWeave = 40;
static const HatchStylePlaid = 41;
static const HatchStyleDivot = 42;
static const HatchStyleDottedGrid = 43;
static const HatchStyleDottedDiamond = 44;
static const HatchStyleShingle = 45;
static const HatchStyleTrellis = 46;
static const HatchStyleSphere = 47;
static const HatchStyleSmallGrid = 48;
static const HatchStyleSmallCheckerBoard = 49;
static const HatchStyleLargeCheckerBoard = 50;
static const HatchStyleOutlinedDiamond = 51;
static const HatchStyleSolidDiamond = 52;
static const HatchStyleTotal = 53;
static const HatchStyleLargeGrid = HatchStyleCross ;
static const HatchStyleMin = HatchStyleHorizontal ;
static const HatchStyleMax = HatchStyleTotal - 1 ;
//DashStyle
static const DashStyleSolid = 0;
static const DashStyleDash = 1;
static const DashStyleDot = 2;
static const DashStyleDashDot = 3;
static const DashStyleDashDotDot = 4;
static const DashStyleCustom = 5;
//DashCap
static const DashCapFlat = 0;
static const DashCapRound = 2;
static const DashCapTriangle = 3;
//LineCap
static const LineCapFlat = 0;
static const LineCapSquare = 1;
static const LineCapRound = 2;
static const LineCapTriangle = 3;
static const LineCapNoAnchor = 0x10; // corresponds to flat cap
static const LineCapSquareAnchor = 0x11; // corresponds to square cap
static const LineCapRoundAnchor = 0x12; // corresponds to round cap
static const LineCapDiamondAnchor = 0x13; // corresponds to triangle cap
static const LineCapArrowAnchor = 0x14; // no correspondence
static const LineCapCustom = 0xff; // custom cap
static const LineCapAnchorMask = 0xf0; // mask to check for anchor or not.
/////CustomLineCapType/////
static const CustomLineCapTypeDefault = 0;
static const CustomLineCapTypeAdjustableArrow = 1;
////LineJoin
static const LineJoinMiter = 0;
static const LineJoinBevel = 1;
static const LineJoinRound = 2;
static const LineJoinMiterClipped = 3;
////PathPointType//////////
static const PathPointTypeStart = 0; // move
static const PathPointTypeLine = 1; // line
static const PathPointTypeBezier = 3; // default Bezier (= cubic Bezier)
static const PathPointTypePathTypeMask = 0x07; // type mask (lowest 3 bits).
static const PathPointTypeDashMode = 0x10; // currently in dash mode.
static const PathPointTypePathMarker = 0x20; // a marker for the path.
static const PathPointTypeCloseSubpath = 0x80; // closed flag
//Path types used for advanced path.
static const PathPointTypeBezier3 = 3; // cubic Bezier
///////////WarpMode///////
static const WarpModePerspective = 0;
static const WarpModeBilinear = 1;
//LinearGradientMode
static const LinearGradientModeHorizontal = 0;
static const LinearGradientModeVertical = 1;
static const LinearGradientModeForwardDiagonal = 2;
static const LinearGradientModeBackwardDiagonal = 3;
///CombineMode
static const CombineModeReplace = 0 ;
static const CombineModeIntersect = 1 ;
static const CombineModeUnion = 2 ;
static const CombineModeXor = 3 ;
static const CombineModeExclude = 4 ;
static const CombineModeComplement = 5 ;
//ImageType
static const ImageTypeUnknown = 0;
static const ImageTypeBitmap = 1;
static const ImageTypeMetafile = 2;
///InterpolationMode
static const InterpolationModeInvalid = QualityModeInvalid;
static const InterpolationModeDefault = QualityModeDefault;
static const InterpolationModeLowQuality = QualityModeLow;
static const InterpolationModeHighQuality = QualityModeHigh;
static const InterpolationModeBilinear = 3;
static const InterpolationModeBicubic = 4;
static const InterpolationModeNearestNeighbor = 5;
static const InterpolationModeHighQualityBilinear = 6;
static const InterpolationModeHighQualityBicubic = 7;
///////PenAlignment//////////////
static const PenAlignmentCenter = 0;
static const PenAlignmentInset = 1;
//BrushType
static const BrushTypeSolidColor = 0;
static const BrushTypeHatchFill = 1;
static const BrushTypeTextureFill = 2;
static const BrushTypePathGradient = 3;
static const BrushTypeLinearGradient = 4;
//PenType
static const PenTypeSolidColor = 0;
static const PenTypeHatchFill = 1;
static const PenTypeTextureFill = 2;
static const PenTypePathGradient = 3;
static const PenTypeLinearGradient = 4;
static const PenTypeUnknown = -1;
//MatrixOrder
static const MatrixOrderPrepend = 0;
static const MatrixOrderAppend = 1;
//////GenericFontFamily
static const GenericFontFamilySerif = 0;
static const GenericFontFamilySansSerif = 1;
static const GenericFontFamilyMonospace = 2;
////FontStyle
static const FontStyleRegular = 0;
static const FontStyleBold = 1;
static const FontStyleItalic = 2;
static const FontStyleBoldItalic = 3;
static const FontStyleUnderline = 4;
static const FontStyleStrikeout = 8;
////SmoothingMode
static const SmoothingModeInvalid = QualityModeInvalid;
static const SmoothingModeDefault = QualityModeDefault;
static const SmoothingModeHighSpeed = QualityModeLow;
static const SmoothingModeHighQuality = QualityModeHigh;
static const SmoothingModeNone = 3 ;
static const SmoothingModeAntiAlias = 4;
////PixelOffsetMode
static const PixelOffsetModeInvalid = QualityModeInvalid;
static const PixelOffsetModeDefault = QualityModeDefault;
static const PixelOffsetModeHighSpeed = QualityModeLow;
static const PixelOffsetModeHighQuality = QualityModeHigh;
static const PixelOffsetModeNone = 3 ;
static const PixelOffsetModeHalf = 4;
///TextRenderingHint
static const TextRenderingHintSystemDefault = 0; // Glyph with system default rendering hint
static const TextRenderingHintSingleBitPerPixelGridFit = 1; // Glyph bitmap with hinting
static const TextRenderingHintSingleBitPerPixel = 2; // Glyph bitmap without hinting
static const TextRenderingHintAntiAliasGridFit = 3; // Glyph anti-alias bitmap with hinting
static const TextRenderingHintAntiAlias = 4; // Glyph anti-alias bitmap without hinting
static const TextRenderingHintClearTypeGridFit = 5; // Glyph CT bitmap with hinting
//MetafileType
static const MetafileTypeInvalid = 0; // Invalid metafile
static const MetafileTypeWmf = 1; // Standard WMF
static const MetafileTypeWmfPlaceable = 2; // Placeable WMF
static const MetafileTypeEmf = 3; // EMF (not EMF+)
static const MetafileTypeEmfPlusOnly = 4; // EMF+ without dual = ; down-level records
static const MetafileTypeEmfPlusDual = 5; // EMF+ with dual = ; down-level records
//EmfType
static const EmfTypeEmfOnly = MetafileTypeEmf;
static const EmfTypeEmfPlusOnly = MetafileTypeEmfPlusOnly;
static const EmfTypeEmfPlusDual = MetafileTypeEmfPlusDual;
///ObjectType
static const ObjectTypeInvalid = 0 ;
static const ObjectTypeBrush = 1 ;
static const ObjectTypePen = 2 ;
static const ObjectTypePath = 3 ;
static const ObjectTypeRegion = 4 ;
static const ObjectTypeImage = 5 ;
static const ObjectTypeFont = 6 ;
static const ObjectTypeStringFormat = 7 ;
static const ObjectTypeImageAttributes = 8 ;
static const ObjectTypeCustomLineCap = 9 ;
////////////////
///StringFormatFlags/////////////////
static const StringFormatFlagsDirectionRightToLeft = 0x00000001;
static const StringFormatFlagsDirectionVertical = 0x00000002;
static const StringFormatFlagsNoFitBlackBox = 0x00000004;
static const StringFormatFlagsDisplayFormatControl = 0x00000020;
static const StringFormatFlagsNoFontFallback = 0x00000400;
static const StringFormatFlagsMeasureTrailingSpaces = 0x00000800;
static const StringFormatFlagsNoWrap = 0x00001000;
static const StringFormatFlagsLineLimit = 0x00002000;
static const StringFormatFlagsNoClip = 0x00004000;
static const StringFormatFlagsBypassGDI = 0x80000000;
/////StringTrimming////////
static const StringTrimmingNone = 0;
static const StringTrimmingCharacter = 1;
static const StringTrimmingWord = 2;
static const StringTrimmingEllipsisCharacter = 3;
static const StringTrimmingEllipsisWord = 4;
static const StringTrimmingEllipsisPath = 5;
//---------------------------------------------------------------------------
// National language digit substitution
//---------------------------------------------------------------------------
static const StringDigitSubstituteUser = 0; // As NLS setting
static const StringDigitSubstituteNone = 1;
static const StringDigitSubstituteNational = 2;
static const StringDigitSubstituteTraditional = 3;
//---------------------------------------------------------------------------
// Hotkey prefix interpretation
//---------------------------------------------------------------------------
static const HotkeyPrefixNone = 0;
static const HotkeyPrefixShow = 1;
static const HotkeyPrefixHide = 2;
//---------------------------------------------------------------------------
// String alignment flags
//---------------------------------------------------------------------------
// Left edge for left-to-right text;
// right for right-to-left text;
// and top for vertical
static const StringAlignmentNear = 0;
static const StringAlignmentCenter = 1;
static const StringAlignmentFar = 2;
////////////DriverStringOptions/////
static const DriverStringOptionsCmapLookup = 1;
static const DriverStringOptionsVertical = 2;
static const DriverStringOptionsRealizedAdvance = 4;
static const DriverStringOptionsLimitSubpixel = 8;
/////FlushIntention///////
static const FlushIntentionFlush = 0;
static const FlushIntentionSync = 1;
//EncoderParameterValueType
static const EncoderParameterValueTypeByte = 1; // 8-bit unsigned int
static const EncoderParameterValueTypeASCII = 2; // 8-bit byte containing one 7-bit ASCII
// code. NULL terminated.
static const EncoderParameterValueTypeShort = 3; // 16-bit unsigned int
static const EncoderParameterValueTypeLong = 4; // 32-bit unsigned int
static const EncoderParameterValueTypeRational = 5; // Two Longs. The first Long is the
// numerator; the second Long expresses the
// denomintor.
static const EncoderParameterValueTypeLongRange = 6; // Two longs which specify a range of
// integer values. The first Long specifies
// the lower end and the second one
// specifies the higher end. All values
// are inclusive at both ends
static const EncoderParameterValueTypeUndefined = 7; // 8-bit byte that can take any value
// depending on field definition
static const EncoderParameterValueTypeRationalRange = 8; // Two Rationals. The first Rational
// specifies the lower end and the second
// specifies the higher end. All values
// are inclusive at both ends
//----------GpTestControlEnum-----------------------------------------------------------------
static const TestControlForceBilinear = 0;
static const TestControlNoICM = 1;
static const TestControlGetBuildNumber = 2;
//EmfToWmfBitsFlags//
static const EmfToWmfBitsFlagsDefault = 0x00000000;
static const EmfToWmfBitsFlagsEmbedEmf = 0x00000001;
static const EmfToWmfBitsFlagsIncludePlaceable = 0x00000002;
static const EmfToWmfBitsFlagsNoXORClip = 0x00000004;
end
implementation
initialization
end.

425
funcext/tvclib/utslvclgdi.tsf
View File

@ -99,6 +99,21 @@ type TGdi = class(TSLUIBASE)
property Canvas read FCanvas write SetCanvas;
property Handle read HandleNeeded;
end
type tpenbushbase = class(tgdi) //alpha 通道的画刷
function create();
begin
inherited;
end
protected
function trans_syscolor(c);
begin
if (c .& 0xff000000) then
begin
return _wapi.GetSysColor(c .& 0x00ffffff);
end
return c;
end
end
type Tcustomfont = class(tgdi)
private
fdwfacename;
@ -481,7 +496,7 @@ type TFontControl=class(Tcustomfont)
function Onchange();override;
begin
inherited;
if FControl then
if FControl and not(FControl.ParentFont) then
begin
FControl.FontChanged();
end
@ -498,7 +513,7 @@ type TFontControl=class(Tcustomfont)
end
property Control read FControl write SetControl;
end
type tcustompen=class(tgdi)
type tcustompen=class(tpenbushbase)
private
FStyle;
FColor;
@ -521,6 +536,9 @@ type tcustompen=class(tgdi)
begin
if not HandleAllocated()then
begin
{$ifndef linux}
if FColor=0x1FFFFFFF then return NULL_PEN;
{$endif}
hp := reference();
if not hp then
begin
@ -529,7 +547,8 @@ type tcustompen=class(tgdi)
w := FWidth;
end else
w := 0;
hp := _wapi.CreatePen(FStyle,w,FColor);
c := trans_syscolor(FColor);
hp := _wapi.CreatePen(FStyle,w,c);
addsource(hp);
end
FHandle := hp;
@ -545,6 +564,7 @@ type tcustompen=class(tgdi)
if Canvas then Canvas.OnPenChange();
DestroyHandle();
end
function SetColor(c);
begin
if ifnumber(c)and c <> FColor then
@ -601,7 +621,7 @@ type tcustompen=class(tgdi)
property Width read FWidth write SetWidth;
property Style read FStyle write SetStyle;
end
type tcustombrush=class(tgdi)
type tcustombrush=class(tpenbushbase)
private
FStyle;
FColor;
@ -646,11 +666,15 @@ type tcustombrush=class(tgdi)
begin
if not HandleAllocated()then
begin
{$ifndef linux}
if FColor = 0x1fffffff then return NULL_BRUSH;
{$endif}
hp := reference();
if not hp then
begin
c := trans_syscolor(FColor);
LOGSTRUCT._setvalue_("lbstyle",FStyle);
LOGSTRUCT._setvalue_("lbcolor",FColor);
LOGSTRUCT._setvalue_("lbcolor",c);
//LOGSTRUCT._setvalue_("lbhatch",FHatch);
hp := _wapi.CreateBrushIndirect(LOGSTRUCT._getptr_);
//hp := _wapi.CreateSolidBrush(FColor);
@ -1347,9 +1371,7 @@ type TcustomBitmap = class(TPicturebase)
end
function CopyRect(x,y,w,h);
begin
{**
@explan(说明) 拷贝位图 %%
**}
return nil;
r := nil;
if HandleAllocated()then
begin
@ -1713,7 +1735,7 @@ type TCustomImageList=class(tcomponent)
FChanged;
FBKColor;
FImages;
FDrawBimpFirst;
FDrawBmpFirst;
FBmpItems;
FBmpAdding;
function inDesigning();
@ -1870,7 +1892,7 @@ type TCustomImageList=class(tcomponent)
FimageCount := 0;
FBKColor :=0xffffff ;//rgb(255,255,255);
FBmpItems := new tnumindexarray();
//FDrawBimpFirst := true;
FDrawBmpFirst := true;
inherited;
end
function HandleAllocated();
@ -1983,7 +2005,7 @@ type TCustomImageList=class(tcomponent)
if indexvalidate(i)then
begin
if not(flag >= 0)then flag := ILD_NORMAL;
if DrawBimpFirst then
if fDrawBmpFirst then
begin
bmp := FBmpItems[i];
if bmp then
@ -2101,7 +2123,7 @@ type TCustomImageList=class(tcomponent)
property OnChange read FOnChange write FOnChange;
property BkColor:COLORREF read FBKColor write setbkcolor;
property Images:imagesdata read GetImages write SetImages;
property DrawBimpFirst read FDrawBimpFirst write FDrawBimpFirst;
property DrawBmpFirst read FDrawBmpFirst write FDrawBmpFirst;
{**
@param(Handle)(HIMAGELIS) imagelist句柄 %%
@param(AutoDestroy)(bool) 是否销毁句柄 %%
@ -2169,7 +2191,14 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明) 画布对象 %%
**}
private
fdcwidth;
fdcheight;
falpha;
FHandle;
FAlphahandle;
falphasaveid;
falphabm;
fhandleback;
FFont;
FBrush;
FPen;
@ -2178,6 +2207,7 @@ type TcustomCanvas = class(TSLUIBASE)
FSaveGdi;
FRgn;
FCounter;
FalphaCounter;
FTabLength;
FTabLenParam;
_xformobj;
@ -2214,6 +2244,120 @@ type TcustomCanvas = class(TSLUIBASE)
FTabLenParam.itablength := nv;
end
end
function setalpha(v);//透明度
begin
if not HandleAllocated() then return ;
if not ifnumber(v) then return ;
nv := integer(v);
if nv>=0 and nv<=255 and nv<>falpha then
begin
oalpha := falpha;
if oalpha<>255 then //透明度改变
begin
copyalphahandle();
flashhandle();
end
falpha := nv;
end
end
function createalphahandle(); //透明度构造临时句柄
begin
{$ifdef linux}
if HandleAllocated() then
begin
if falpha<>255 then _wapi.g_object_set_data(FHandle,"alpha",falpha);
return 0;
end
{$endif}
if not(FAlphahandle) and (falpha<>255) then
begin
///////////////////旋转判断 并且还原/////////////////////////////////////
hast := _wapi.getWorldTransform(FHandle,_xformobj._getptr_);
ts := _xformobj._getdata_();
if not(hast and (ts<>array(1.0,0.0,0.0,1.0,0.0,0.0))) then
begin
ts := nil;
end
if ts then
begin
_xformobj.em11 := 1;
_xformobj.em12 := 0;
_xformobj.em21 := 0;
_xformobj.em22 := 1;
_xformobj.edx := 0;
_xformobj.edy := 0;
_wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
end
////////////////////////////////////////////
fhandleback := FHandle;
ps := array(0,0);
_wapi.GetCurrentPositionEx(FHandle,ps);
fdcwidth := _wapi.GetDeviceCaps(FHandle,8);
fdcheight := _wapi.GetDeviceCaps(FHandle,10);
FAlphahandle := _wapi.CreateCompatibleDC(fhandleback);
falphabm := _wapi.CreateCompatibleBitmap(fhandleback,fdcwidth,fdcheight);
falphabmold := _wapi.SelectObject(FAlphahandle,falphabm);
_wapi.BitBlt(FAlphahandle,0,0,fdcwidth,fdcheight,fhandleback,0,0,SRCCOPY);
falphasaveid := _wapi.SaveDC(FAlphahandle);
////////////////////旋转当前的画布///////////////////////////////////////
_wapi.SetGraphicsMode(FAlphahandle,2);
if ts then
begin
_xformobj.em11 := ts[0];
_xformobj.em12 := ts[1];
_xformobj.em21 := ts[2];
_xformobj.em22 := ts[3];
_xformobj.edx := ts[4];
_xformobj.edy := ts[5];
_wapi.SetWorldTransform(FAlphahandle,_xformobj._getptr_);
end
////////////////////////////////////////////////
_wapi.MoveToEx(FAlphahandle,ps[0],ps[1],ps);
FHandle := FAlphahandle;
FalphaCounter := new TCounter();
flashhandle();
end
end
function copyalphahandle();//透明度取消临时句柄
begin
{$ifdef linux}
if HandleAllocated() then
begin
falpha := 255;
return _wapi.g_object_set_data(FHandle,"alpha",nil);
end
{$endif}
if FAlphahandle then
begin
FalphaCounter := nil;
////////////////////当前旋转判断//////////////////////////////////////////////////
hast := _wapi.getWorldTransform(FAlphahandle,_xformobj._getptr_);
ts := _xformobj._getdata_();
if not(hast and (ts<>array(1.0,0.0,0.0,1.0,0.0,0.0))) then
begin
ts := nil;
end
///////////////////////////////////////////////
_wapi.RestoreDC(FAlphahandle,falphasaveid);
_wapi.AlphaBlend(fhandleback,0,0,fdcwidth,fdcheight,FAlphahandle,0,0,fdcwidth,fdcheight,(_shl(falpha,16)));
////////////////////旋转原有的画布//////////////////////
if ts then
begin
_wapi.SetWorldTransform(fhandleback,_xformobj._getptr_);
end
FHandle := fhandleback;
fhandleback := 0;
ps := array(0,0);
_wapi.GetCurrentPositionEx(FAlphahandle,ps);
_wapi.SelectObject(FAlphahandle, falphabmold);
_wapi.DeleteDC(FAlphahandle);
_wapi.DeleteObject(falphabm);
FAlphahandle := 0;
falpha := 255;
_wapi.MoveToEx(FHandle,ps[0],ps[1],ps);
end
end
function SetPen(p);
begin
FPen.copypen(p);
@ -2237,14 +2381,29 @@ type TcustomCanvas = class(TSLUIBASE)
return _wapi.SelectObject(FHandle,hgdi);
end
end
function gethandle();
begin
if fhandleback then return fhandleback;
return FHandle;
end
function getchandle();
begin
return FHandle;
end
function SetHandle(h);
begin
if ifnumber(h)then
begin
flashhandle();
if FHandle <> h then
if GetHandle()=h then return ;
copyalphahandle();
if HandleAllocated() then
begin
FCounter.clean();
if FCounter.CurrenId>0 then
begin
FCounter.DeCrease();
_wapi.RestoreDC(FHandle,-1);
end
end
FHandle := h;
if h then
@ -2343,6 +2502,7 @@ type TcustomCanvas = class(TSLUIBASE)
function create();override;
begin
inherited;
falpha := 255;
FTabLength := 0;
FCounter := new TCounter();
FHandle := 0;
@ -2387,6 +2547,7 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if HandleAllocated()then
begin
createalphahandle();
if FState .& 1 then
begin
SelectObject(FPen.Handle);
@ -2442,19 +2603,19 @@ type TcustomCanvas = class(TSLUIBASE)
begin
FState .|= 16;
end
function SetViewportOrg(xy);
begin
{**
@explan(说明)设置选择基准点 %%
@param(xy)(array) array(x,y)%%
@return(integer) %%
**}
if HandleAllocated()then
begin
if not ifarray(xy)then return 0;
return _wapi.SetViewportOrgEx(FHandle,xy[0],xy[1],nil);
end
end
// function SetViewportOrg(xy);
// begin
// {**
// @explan(说明)设置选择基准点 %%
// @param(xy)(array) array(x,y)%%
// @return(integer) %%
// **}
// if HandleAllocated()then
// begin
// if not ifarray(xy)then return 0;
// return _wapi.SetViewportOrgEx(FHandle,xy[0],xy[1],nil);
// end
// end
function SetPixel(xy,colr);
begin
{**
@ -2484,6 +2645,7 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if HandleAllocated()then
begin
createalphahandle();
return _wapi.FillRect(FHandle,(ifrect(rec)?rec:zeros(4)),FBrush.Handle);
end
end
@ -2496,7 +2658,7 @@ type TcustomCanvas = class(TSLUIBASE)
if not HandleAllocated()then exit;
return _wapi.InvertRect(FHandle,rec,FBrush.Handle);
end
function moveto(pos);
function moveto(pos);overload;
begin
{**
@explan(说明)移动当前点%%
@ -2511,7 +2673,11 @@ type TcustomCanvas = class(TSLUIBASE)
end
return ret;
end
function lineto(pos); //画线
function moveto(x,y);overload;
begin
if ifnumber(x) and ifnumber(y) then return moveto(array(x,y));
end
function lineto(pos);overload; //画线
begin
{**
@explan(说明)画线到点%%
@ -2524,6 +2690,10 @@ type TcustomCanvas = class(TSLUIBASE)
return _wapi.LineTo(FHandle,pos[0],pos[1]);
end
end
function lineto(x,y);overload;
begin
if ifnumber(x) and ifnumber(y) then return lineto(array(x,y));
end
function textout(str,pos); //输出文字,str文字,pos开始位置
begin
{**
@ -2577,6 +2747,7 @@ type TcustomCanvas = class(TSLUIBASE)
@param(bmp)(tcustombitmap) 位图 %%
**}
if not(bmp is class(tcustombitmap))then exit;
createalphahandle();
bmp.StretchDraw(self,rec);
end
function DrawBitmap(bmp,p);
@ -2588,6 +2759,7 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if not(bmp is class(tcustombitmap))then return-1;
if not ifarray(p)then p := array(0,0);
createalphahandle();
bmp.draw(self,p[0],p[1]);
end
function DrawIcon(ico,p);
@ -2599,6 +2771,7 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if HandleAllocated()then
begin
createalphahandle();
if not(ifarray(p)and ifnumber(p[1])and ifnumber(p[0]))then p := array(0,0);
if(ico is class(tcustomicon))and ico.Handle then return _wapi.DrawIcon(FHandle,p[0],p[1],ico.Handle);
end
@ -2732,27 +2905,40 @@ type TcustomCanvas = class(TSLUIBASE)
return ret;
end
function CopyBitmap(rect);
function CopyBitmap(rec);
begin
{**
@explan(说明) 获取canvas区域到位图 %%
@param(array of integer) 区域 array(左,上,右,下);
@return(tcustombitmap|nil) 成功返回位图 %%
**}
r := nil;
R := new tcustombitmap();
{$ifdef linux}
sf := _wapi.gtk_object_get_data(FHandle,"-surface-");
if sf then
begin
fn := temppath()+"/-tempsurface-.png";
CreateDirWithFileName(fn);
if 0=_wapi.cairo_surface_write_to_png(sf,(fn)) then r.id := fn;
else return 0;
end
return r;
{$endif}
if not(ifarray(rect)and rect[2]>rect[0]and rect[3]>rect[1])then return r;
if not HandleAllocated()then return r;
rect := rec;
if not(ifarray(rect)and rect[2]>rect[0]and rect[3]>rect[1])then
begin
dcw := _wapi.GetDeviceCaps(FHandle,8);
dch := _wapi.GetDeviceCaps(FHandle,10);
rect := array(0,0,dcw,dch);
end
if not FHDC then FHDC := _wapi.CreateCompatibleDC(0);
if not FHDC then return r;
bthandle := _wapi.CreateCompatibleBitmap(_wapi.GetDC(0),w,h);
bthandle := _wapi.CreateCompatibleBitmap(FHDC,rect[2]-rect[0],rect[3]-rect[1]);
if not bthandle then return r;
oldb := _wapi.SelectObject(FHDC,bthandle);
_wapi.BitBlt(FHDC,0,0,rect[2]-rect[0],rect[3]-rect[1],FHandle,rect[0],rect[1],SRCCOPY);
if oldb then _wapi.SelectObject(FHDC,oldb);
R := new tcustombitmap();
R.handle := bthandle;
return r;
end
@ -2762,15 +2948,17 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明)文本旋转%%
@param(t)(array) array(cos,-sin,sin,cos,x,y)%%
**}
{$ifdef linux}
return r;
{$endif}
_xformobj.em11 := t[0];
_xformobj.em12 := t[1];
_xformobj.em21 := t[2];
_xformobj.em22 := t[3];
_xformobj.edx := t[4];
_xformobj.edy := t[5];
{$ifdef linux}
_wapi.cairo_identity_matrix(FHandle);
_wapi.cairo_transform(FHandle,_xformobj._getptr_);
return true;
{$endif}
return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
end
function trans(ag,x,y,clockwise);
@ -2779,11 +2967,12 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明)文本旋转%%
@param(ag)(double) 角度%%
**}
{$ifdef linux}
_wapi.cairo_translate(FHandle,x,y);
_wapi.cairo_rotate(FHandle,clockwise?ag:(-ag));
return 1;
{$endif}
// {$ifdef linux}
// //tm := Ttagxform(nil);
// _wapi.cairo_translate(FHandle,x,y);
// _wapi.cairo_rotate(FHandle,clockwise?ag:(-ag));
// return 1;
// {$endif}
if clockwise then return trans(-ag,x,y);
_xformobj.em11 := cos(ag);
_xformobj.em12 := -sin(ag);
@ -2791,6 +2980,11 @@ type TcustomCanvas = class(TSLUIBASE)
_xformobj.em22 := cos(ag);
_xformobj.edx := ifnumber(x)?x:0;
_xformobj.edy := ifnumber(y)?y:0;
{$ifdef linux}
_wapi.cairo_identity_matrix(FHandle);
_wapi.cairo_transform(FHandle,_xformobj._getptr_);
return true;
{$endif}
return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_);
end
function SetPolyFillMode(md); //设置填充样式
@ -2858,12 +3052,12 @@ type TcustomCanvas = class(TSLUIBASE)
begin
requiregdi();
if HandleAllocated() then return _wapi.StrokeAndFillPath(FHandle);
end}
end
function DeleteDC();
begin
if HandleAllocated()then _wapi.DeleteDC(FHandle);
FHandle := 0;
end
end}
function SaveDC();
begin
{**
@ -2871,6 +3065,8 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if HandleAllocated()then
begin
if FalphaCounter then FCounter.InCrease();
else
FCounter.InCrease();
_wapi.SaveDC(FHandle);
end
@ -2882,15 +3078,19 @@ type TcustomCanvas = class(TSLUIBASE)
**}
if HandleAllocated()then
begin
if FCounter.CurrenId>0 then
ct := FalphaCounter?FalphaCounter:FCounter;
if ct.CurrenId>0 then
begin
FCounter.DeCrease();
ct.DeCrease();
_wapi.RestoreDC(FHandle,-1);
FState := 1+2+4+8+16+32;
return 1;
end
end
end
property Handle read FHandle write SetHandle;
property alpha read falpha write setAlpha; //透明度0（完全透明） 到255（不透明）
property Handle read gethandle write SetHandle; //原始句柄
property chandle read getchandle; //当前绘制的画布
property pen read FPen write SetPen;
property font read FFont write SetFont;
property brush read FBrush write SetBrush;
@ -2905,6 +3105,110 @@ type TcustomCanvas = class(TSLUIBASE)
@param(TextMetric)(ttagTEXTMETRICA) 文本样式信息 %%
**}
end
type tcustommemcanvas = class(tcustomcanvas)
{**
@explan(说明) 内存画布，支持保存png文件 %%
**}
function create(w,h);
begin
{**
@explan(说明) 构造内存画布 %%
@param(w)(integer) 宽度 %%
@param(h)(integer) 高度 %%
**}
inherited create();
{$ifdef linux}
get_w_h(w,h,wo,ho);
fimg := _wapi.cairo_image_surface_create(1,wo,ho);
fcurhdc := _wapi.cairo_create(fimg);
_wapi.gtk_object_set_data(fcurhdc,nil);
_wapi.gtk_object_set_data(fcurhdc,"-surface-",fimg);
{$else}
folddc := _wapi.GetDC(0);
get_w_h(w,h,wo,ho);
fimg := _wapi.CreateCompatibleBitmap(folddc,wo,ho);
fcurhdc := _wapi.CreateCompatibleDC(folddc);
foimg := _wapi.SelectObject(fcurhdc,fimg);
fsaveid := _wapi.SaveDC(fcurhdc);
_wapi.SetGraphicsMode(fcurhdc,2);
{$endif}
handle := fcurhdc;
end
function destroy();override;
begin
{$ifdef linux}
_wapi.cairo_surface_destroy(fimg);
_wapi.cairo_destroy(fcurhdc);
{$else}
_wapi.ReleaseDC(0,folddc);
_wapi.SelectObject(fcurhdc,foimg);
_wapi.DeleteDC(fcurhdc);
_wapi.DeleteObject(fimg);
{$endif}
handle := 0;
inherited;
end
function savepng(fn); //保存png
begin
{**
@explan(说明) 保存为png文件 %%
@param(fb)(string) 文件名，非.png结尾会自动添加.png后缀 %%
**}
fn_ := fn;
if ifstring(fn_) and fn_ then
begin
hd := handle;
ba := alpha;
if ba<>255 then alpha := 255;
if parseregexpr("\\.png$",fn_,"",m,mp,ml)<>1 then fn_+=".png";
{$ifdef linux}
sf := _wapi.gtk_object_get_data(hd,"-surface-");
if sf then
begin
fn_ := ansitoutf8(fn_);
CreateDirWithFileName(fn_);
r := ( 0=_wapi.cairo_surface_write_to_png(sf,(fn_)));
end
{$else}
nmg := new tcustomimage();
nmg.FromHBitmap(fimg);
r := nmg.SavetoFile(fn_,"png");
{$endif}
if ba<>255 then alpha := ba;
return r;
end
end
property width read FWidth;
property height read fheight;
private
function get_w_h(w,h,wo,ho);
begin
{$ifdef linux}
if w>0 then wo := int(w);
else
wo := _wapi.gdk_screen_width()-50;
if h>0 then ho := int(w);
else ho := _wapi.gdk_screen_height()-50;
{$else}
if w>0 then wo := int(w);
else
wo := _wapi.GetDeviceCaps(folddc,8);
if h>0 then ho := int(w);
else ho := _wapi.GetDeviceCaps(folddc,10);
{$endif}
FWidth := wo;
fheight := ho;
end
private
FWidth;
fheight;
fimg;
foimg;
fcurhdc;
folddc;
end
type TControlCanvs=class(TcustomCanvas)
function Create();
begin
@ -3117,7 +3421,7 @@ type tshapeEllipse = class(tshape,tshaperect)
begin
if fcanvas and fcanvas.HandleAllocated() and frect then
begin
fcanvas._wapi.Ellipse(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]);
fcanvas._wapi.Ellipse(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3]);
end
return inherited;
end
@ -3133,7 +3437,7 @@ type tshapeRectangle = class(tshape,tshaperect)
begin
if fcanvas and fcanvas.HandleAllocated() and frect then
begin
fcanvas._wapi.Rectangle(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]);
fcanvas._wapi.Rectangle(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3]);
end
return inherited;
end
@ -3147,7 +3451,7 @@ type tshaperoundrect = class(tshape,tshaperect)
begin
if fcanvas and fcanvas.HandleAllocated() and frect then
begin
fcanvas._wapi.RoundRect(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],froundw,froundh);
fcanvas._wapi.RoundRect(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3],froundw,froundh);
end
return inherited;
end
@ -3170,7 +3474,7 @@ type tshapeframe = class(tshape,tshaperect)
begin
if fcanvas and fcanvas.HandleAllocated() and frect then
begin
fcanvas._wapi.DrawFrameControl(fcanvas.handle,frect,ftype,fstyle);
fcanvas._wapi.DrawFrameControl(fcanvas.chandle,frect,ftype,fstyle);
end
return inherited;
end
@ -3197,8 +3501,8 @@ type tshapearc = class(tshape,tshaperect,tsepoint)
begin
if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then
begin
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
fcanvas._wapi.arc(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.cHandle,fdir);
fcanvas._wapi.arc(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
end
return inherited;
end
@ -3212,8 +3516,8 @@ type tshapepie = class(tshape,tshaperect,tsepoint)
begin
if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then
begin
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
fcanvas._wapi.pie(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.CHandle,fdir);
fcanvas._wapi.pie(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
end
return inherited;
end
@ -3227,8 +3531,8 @@ type tshapechord = class(tshape,tshaperect,tsepoint)
begin
if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then
begin
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir);
fcanvas._wapi.chord(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.CHandle,fdir);
fcanvas._wapi.chord(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]);
end
return inherited;
end
@ -3242,7 +3546,7 @@ type tshapepolygon = class(tshapepolyline)
begin
if fcanvas and fcanvas.HandleAllocated() and fbpoints then
begin
fcanvas._wapi.Polygon(fcanvas.handle,fbpoints,length(fbpoints));
fcanvas._wapi.Polygon(fcanvas.Chandle,fbpoints,length(fbpoints));
end
return inherited;
end
@ -3283,7 +3587,7 @@ type tshapepolyline = class(tshape)
begin
if fcanvas and fcanvas.HandleAllocated() and fbpoints then
begin
fcanvas._wapi.polyline(fcanvas.handle,fbpoints,length(fbpoints));
fcanvas._wapi.polyline(fcanvas.Chandle,fbpoints,length(fbpoints));
end
return self(true);
end
@ -3300,7 +3604,7 @@ type tshapeBezier = class(tshape)
begin
if fcanvas and fcanvas.HandleAllocated() and fbpoints then
begin
fcanvas._wapi.PolyBezier(fcanvas.handle,fbpoints,length(fbpoints));
fcanvas._wapi.PolyBezier(fcanvas.Chandle,fbpoints,length(fbpoints));
end
return inherited;
end
@ -3462,6 +3766,7 @@ begin
end
return r;
end
function get_imagecodec_(n);
begin
r := array();

14
funcext/tvclib/utslvclmemstruct.tsf
View File

@ -1436,11 +1436,22 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj)
private
FPonter;
end
type Ttagxform=class(tslcstructureobj)
type Ttagxform=class(tslcstructureobj) //¼æÈÝcairo ºÍ gdi
private
static SSTRUCT;
class function getstruct()
begin
{$ifdef linux}
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
(0,"double",0),
(1,"double",0),
(2,"double",0),
(3,"double",0),
(4,"double",0),
(5,"double",0)
)
);
{$else}
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
(0,"float",0),
(1,"float",0),
@ -1450,6 +1461,7 @@ type Ttagxform=class(tslcstructureobj)
(5,"float",0)
)
);
{$endif}
return SSTRUCT;
end
public

12
funcext/tvclib/utslvclpage.tsf
View File

@ -155,12 +155,12 @@ type tcustompagecontrol = class(TCustomControl)
begin
FirstViewIndex := 0;
end
ybase := 0;
ybase := rec[1];
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(0,ybase,FTabHeight,ybase+FTabItemswidth[i]-1);
FTabRects[i] := array(rec[0],ybase,FTabHeight+rec[0],ybase+FTabItemswidth[i]-1);
ybase+=FTabItemswidth[i];
if xbase>(rec[3]-FTabHeight-FTabHeight) then break;
end
@ -180,7 +180,7 @@ type tcustompagecontrol = class(TCustomControl)
Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]);
end else
FirstViewIndex := 0;
ybase := 0;
ybase := rec[1];
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
@ -211,12 +211,12 @@ type tcustompagecontrol = class(TCustomControl)
Fnextrect := array(rec[2]-FTabHeight,rec[1],rec[2],rec[1]+FTabHeight);
Fprevrect := array(rec[2]-FTabHeight*2,rec[1],rec[2]-FTabHeight,rec[1]+FTabHeight);
end else FirstViewIndex := 0;
xbase := 0;
xbase := rec[0];
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then
begin
FTabRects[i] := array(xbase,0,xbase+FTabItemswidth[i]-1,FTabHeight);
FTabRects[i] := array(xbase,rec[1],xbase+FTabItemswidth[i]-1,FTabHeight+rec[1]);
xbase+=FTabItemswidth[i];
if xbase>(rec[2]-FTabHeight-FTabHeight) then break;
end else
@ -235,7 +235,7 @@ type tcustompagecontrol = class(TCustomControl)
Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]);
Fprevrect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2]-FTabHeight,rec[3]);
end else FirstViewIndex := 0;
xbase := 0;
xbase := rec[0];
for i,v in FTabItemswidth do
begin
if i>=FirstViewIndex then

219
funcext/tvclib/utslvclstdctl.tsf
View File

@ -331,7 +331,11 @@ type tcustombtn = class(TCustomControl) //
**}
function Create(aowner);
begin
FtextPosition := 0;
inherited;
Parentcolor := false;
//Border := true;
//bordercolor := rgb(200,200,200);
fbtntimer := new TCustomTimer(self);
fbtntimer.Ontimer := thisfunction(judgestate);
end
@ -456,7 +460,8 @@ type tcustombtn = class(TCustomControl) //
if true then //绘制边框
begin
C := 0x090909;
dc.pen.Color := max(0,Color-c);
bc := Color;
dc.pen.Color := max(0,bc-c);
dc.pen.Width := 1;
rec := cr;
rec[2]-=1;
@ -1185,7 +1190,7 @@ type teditable=class(TSLUIBASE) //
else dc.pen.color := 11842740;//rgb(180,180,180);
if fhost.Enabled then
dc.brush.Color := FHost.Color;
else dc.brush.color := cl_disabled_brush;
else dc.brush.color := cldisabledbk;
dc.draw("RoundRect",array(rbc[0:1],rbc[2:3],array(3,3)));
end
end
@ -2374,6 +2379,124 @@ type tVirtualCalender=class(TSLUIBASE)
FCellWidth;
FCellHeight;
end
type tcustombevel = class(TGraphicControl)
{**
@explan(˵Ã÷)bevel¿Ø¼þ %%
**}
function create(AOwner);
begin
inherited;
caption := "";
fshape := bsbox;
fstyle := bsLowered;
end
function paint();override;
begin
if iffuncptr(OnPaint) then call(OnPaint,self(true));
cvs := Canvas;
cvs.pen.Width := 1;
aleft := 0;
atop := 0;
AWidth := Width;
AHeight := Height;
if fstyle=bsRaised then
begin
Colora := cl3DHilight;
Colorb := cl3DShadow;
end else
begin
Colora := cl3DShadow;
Colorb := cl3DHilight;
end
case fshape of
bsbox:
begin
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft, ATop + AHeight - 1));
cvs.LineTo(array(ALeft, ATop));
cvs.LineTo(array(ALeft + AWidth - 1, ATop));
cvs.Pen.Color:=Colorb;
cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1));
cvs.LineTo(array(ALeft , ATop + AHeight - 1));
end
bsframe:
begin
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft, ATop + AHeight - 1));
cvs.LineTo(array(ALeft, ATop));
cvs.LineTo(array(ALeft + AWidth - 1, ATop));
cvs.MoveTo(array(ALeft + AWidth - 2, ATop + 1));
cvs.LineTo(array(ALeft + AWidth - 2, ATop + AHeight - 2));
cvs.LineTo(array(ALeft + 1, ATop + AHeight - 2));
cvs.Pen.Color:=Colorb;
cvs.MoveTo(array(ALeft + 1, ATop + AHeight - 2));
cvs.LineTo(array(ALeft + 1, ATop + 1));
cvs.LineTo(array(ALeft + AWidth - 2, ATop + 1));
cvs.MoveTo(array(ALeft + AWidth - 1, ATop));
cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1));
cvs.LineTo(array(ALeft, ATop + AHeight - 1));
end
bsTopLine:
begin
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft, ATop));
cvs.LineTo(array(ALeft + AWidth - 1, ATop));
cvs.Pen.Color:=Colorb;
cvs.MoveTo(array(ALeft, ATop + 1));
cvs.LineTo(array(ALeft + AWidth - 1, ATop + 1));
end
bsBottomLine:
begin
cvs.Pen.Color:=Colorb;
cvs.MoveTo(array(ALeft, ATop + AHeight - 1));
cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1));
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft, ATop + AHeight - 2));
cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 2));
end
bsLeftLine:
begin
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft, ATop));
cvs.LineTo(array(ALeft, ATop + AHeight - 1));
cvs.Pen.Color:=Colorb;
cvs.MoveTo(array(ALeft + 1, ATop));
cvs.LineTo(array(ALeft + 1, ATop + AHeight - 1));
end
bsRightLine:
begin
cvs.Pen.Color:=Colorb;
cvs.MoveTo(array(ALeft + AWidth - 1, ATop));
cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1));
cvs.Pen.Color:=Colora;
cvs.MoveTo(array(ALeft + AWidth - 2, ATop));
cvs.LineTo(array(ALeft + AWidth - 2, ATop + AHeight));
end
end
end
published
property shape:tbevelshape read fshape write setshape;
property style:tbevelstyle read fstyle write setstyle;
protected
private
function setshape(v);
begin
if not( v in array(0,1,2,3,4,5,6)) then return ;
if v=fshape then return ;
fshape := v;
InvalidateRect(nil,false);
end
function setstyle(v);
begin
if not( v in array(0,1)) then return ;
if v=fstyle then return ;
fstyle := v;
InvalidateRect(nil,false);
end
fshape;
fstyle;
end
type TcustomLabel = class(TGraphicControl)
{**
@explan(说明)标签控件 %%
@ -2473,14 +2596,28 @@ type tcustomedit=class(TCustomControl)
function AfterConstruction();override;
begin
inherited;
Border := true;
Left := 10;
Top := 10;
//Ftextalign := 0;
Width := 80;
Height := 25;
FEditable := new TEntryEditable();
FEditable.Border := false;
FEditable.host := self(true);
end
function ncpaint(rec);override;
begin
dc := Canvas;
ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0));
dc.moveto(ls[3]);
dc.pen.color := rgb(236,236,236);
dc.LineTo(ls[0]);
dc.LineTo(ls[1]);
dc.LineTo(ls[2]);
dc.pen.color := rgb(131,131,131);
dc.LineTo(ls[3]);
end
function ExecuteCommand(cmd,pm);override;
begin
if FEditable then return FEditable.ExecuteCommand(cmd,pm);
@ -2599,7 +2736,7 @@ type tcustomedit=class(TCustomControl)
property limitlength:integer read getlimitlength write setLimitLength;
property LineWrap:bool read getLineWrap write setLineWrap;
property placeholder:string read getplaceholder write Setplaceholder;
property Border:bool read getBorder write SetBorder;
//property Border:bool read getBorder write SetBorder;
{**
@param(LineWrap)(bool)自动换行,默认为false不自动换行%%
@param(onmaxtext)(fpointer)达到文本最大回调%%
@ -2616,14 +2753,14 @@ type tcustomedit=class(TCustomControl)
r[3]-=1;
return r;
end
function getBorder();
{function getBorder();
begin
if FEditable then return FEditable.Border;
end
function setBorder(s);override;
begin
if FEditable then return FEditable.Border := s;
end
end}
function getentrytext();
begin
if FEditable then return FEditable.text;
@ -3033,12 +3170,14 @@ type TCustomListBoxbase=class(TCustomScrollControl)
protected /////////////////滚动条相关//////////////////////////////////////////
function GetClientXCapacity();virtual; //宽度容量
begin
r := integer(ClientRect[2]/GetXScrollDelta());
c := ClientRect;
r := integer(c[2]/GetXScrollDelta());
return r;
end
function GetClientYCapacity();virtual; //高度容量
begin
return integer(ClientRect[3]/GetYScrollDelta());
c := ClientRect;
return integer(c[3]/GetYScrollDelta());
end
function GetClientXCount();virtual; //宽度间隔
begin
@ -3085,6 +3224,15 @@ type TCustomListBoxbase=class(TCustomScrollControl)
autoscroll := 1;
ThumbTrack := true;
FScroolChanged := false;
Border := true;
//bordercolor := rgb(130,135,144);
end
function ncpaint(rec);override;
begin
dc := Canvas;
ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0));
dc.pen.color := rgb(130,135,144);
dc.draw("polyline",ls);
end
function UpDateScrollBar(); //滚动条改变
begin
@ -3116,8 +3264,9 @@ type TCustomListBoxbase=class(TCustomScrollControl)
ypos := GetYPos();
// 计算需要重绘的区域
ps := PAINTSTRUCT().rcPaint;
tp := ps[1];
bo := ps[3];
c := ClientRect;
tp := max(ps[1],c[1]);
bo := min(ps[3],c[3]);
FirstLine := integer(max(0,yPos+(tp)/GetYScrollDelta()));
LastLine := integer(min(FItemCount-1,yPos+(bo)/GetYScrollDelta()));
cvs := Canvas;
@ -3193,7 +3342,7 @@ type TCustomListBoxbase=class(TCustomScrollControl)
xp := GetXpos();
DY := GetYScrollDelta();
rc[1]:=(idx-yp) * DY;
rc[0]:=(0-xp) * GetXScrollDelta();
rc[0]:=(0-xp) * GetXScrollDelta()+rc[0];
rc[3]:= rc[1]+DY;
return rc;
end
@ -3271,6 +3420,7 @@ type TCustomListBoxbase=class(TCustomScrollControl)
function FontChanged(o);override;
begin
ft := Font;
if not ft then return ;
wd := ft.width;
h := ft.Height;
if h <> FFontHeight or wd <> FFontWidth then
@ -4307,7 +4457,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
CallMessgeFunction(Foneditchanged,o,e);
if FMultisel then return feditischanging:=false;
t := o.Text;
if t = getCurrentItemText() then return ;
if t = getCurrentItemText() then return feditischanging:=false;
for i,v in items do
begin
if t = v then
@ -6060,7 +6210,10 @@ end
type tcustomgroupbox=class(TCustomControl)
function create(owner);override;
begin
ftwidth := 7;
ftheight := 15;
inherited;
Parentcolor := false;
Left := 10;
Top := 10;
Width := 185;
@ -6072,23 +6225,18 @@ type tcustomgroupbox=class(TCustomControl)
function Paint();override;
begin
c := caption;
if Parent and ParentFont then
begin
ft := Parent.Font;
end else
ft := Font;
wf := ft.width;
hf := ft.height+2;
wf := ftwidth;
hf := ftheight+2;
cvs := Canvas;
cvs.font := ft;
cvs.pen.color := 11184810;//rgb(170,170,170);
cvs.font := Font;
cvs.pen.color := rgb(210,210,210);//rgb(170,170,170);
cvs.pen.width := 1;
cwd := 0;
if c then
begin
cwd := wf * length(c)+1;
end
rc := ClientRect;
rc := class(TWinControl).GetClientRect();
hf2 := integer(hf/2);
///////////////////////////////////////
cvs.moveto(array(3,hf2));
@ -6122,6 +6270,25 @@ type tcustomgroupbox=class(TCustomControl)
drawdesigninggrid();
/////////////////////////////////
end
function FontChanged(o);override;
begin
inherited;
ft := Font;
ftwidth := ft.Width;
ftheight := ft.Height;
doControlALign();
end
function GetClientRect();override;
begin
r := inherited;
r[0]+=4;
r[1]+=ftheight+4;
r[2]-=4;
r[3]-=4;
if r[2]<r[0] then r[2] := r[0];
if r[3]<r[1] then r[3] := r[1];
return r;
end
published
property textPos:AlignStyle9 read FtextPosition write setTextPosition;
private
@ -6133,6 +6300,16 @@ type tcustomgroupbox=class(TCustomControl)
InvalidateRect(nil,false);
end
end
private
function calc_rec();
begin
end
ftwidth;
ftheight;
frecplus ;
fspacewidth;
FtextPosition;
end
type tcustomprogressbar=class(TCustomControl)

177
funcext/tvclib/utslvcltree.tsf
View File

@ -111,7 +111,7 @@ type ttreelistwnd = class(TCustomScrollControl)
FItems := new tnumindexarrayex();
FColWidth := 10;
FColCount := 0;
FItemHeight := 25;
FItemHeight := font.height+2;
FxClientMax := fColWidth;
FItemMinWidth := FxClientMax;
height := 400;
@ -602,7 +602,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
FExpandPos; //展开按钮位置
FExpandWidth; //展开按钮宽度
FCheckWidth; //checkbox宽度
FFocusColor;
//FFocusColor;
FHierarchyWidth;
function DrawCheckBox(cvs,x,rec,sz,flag); //绘制checkbox
begin
@ -625,18 +625,68 @@ type TcustomTreeCtlNode = class(tsluibase) //
cvs.brush.color :=0x0a0a0a ;//rgb(10,10,10);
cvs.fillrect(dr[0]+8 union dr[1]-4);
ow := Owner;
if self=ow.CurrentNode then cvs.brush.color := FFocusColor[ow.hasFocus()];
if self=ow.CurrentNode then cvs.brush.color := ow.selectionColor;//FFocusColor[ow.hasFocus()];
else cvs.brush.color := ow.Color;
end
end
end
function DrawExpand(cvs,x,rec,sz,flag); //绘制展开按钮
begin
ow := Owner;
if not ow then return ;
sz2 := integer(sz/2);
y := rec[1];
h := rec[3];
ys := y+(h-sz)/2;
bc := cvs.brush.color;
cvs.Pen.Color := ow.expandsigncolor;//rgb(50,50,50);
cvs.Pen.style := PS_SOLID;
case ow.expandsigntype of
tvestTheme:
begin
cvs.Pen.width := 2;
if flag then
begin
cvs.MoveTo(array(x,ys));
cvs.LineTo(array(x+sz2,ys+sz-2));
cvs.LineTo(array(x+sz,ys));
end else
begin
cvs.MoveTo(array(x,ys));
cvs.LineTo(array(x+sz-2,ys+sz2));
cvs.LineTo(array(x,ys+sz));
end
end
tvestArrow:
begin
cvs.Pen.width := 2;
if flag then
begin
ps := array((x,ys),(x+sz2,ys+sz-2),(x+sz,ys),(x,ys));
end else
begin
ps := array((x,ys),(x+sz-2,ys+sz2),(x,ys+sz),(x,ys));
end
cvs.brush.color := ow.color;
cvs.draw("polygon",ps);
end
tvestArrowFill:
begin
if flag then
begin
ps := array((x,ys),(x+sz2,ys+sz-2),(x+sz,ys),(x,ys));
end else
begin
ps := array((x,ys),(x+sz-2,ys+sz2),(x,ys+sz),(x,ys));
end
cvs.brush.color := cvs.pen.color;
cvs.draw("polygon",ps);
end
else
//tvestPlusMinus:
begin
dr := array(array(x,ys),array(x+sz,ys+sz));
cvs.brush.color := ow.color;
cvs.draw("rectangle",dr);
cvs.MoveTo(array(x+2,ys+sz/2));
cvs.LineTo(array(x+sz-2,ys+sz/2));
@ -646,6 +696,10 @@ type TcustomTreeCtlNode = class(tsluibase) //
cvs.LineTo(array(x+sz/2,ys+sz-2));
end
end
end;
cvs.brush.color := bc;
cvs.pen.Width := 1;
end
function ChildChecked();
begin
@ -694,7 +748,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
FVisible := true;
FMouseCanChecked := true;
FModifyChildrenChecked := true;
FFocusColor := array(0xfaf0e6,0xfac000) ;//array(rgb(230,240,250),rgb(0,192,250));
//FFocusColor := array(0xfaf0e6,0xfac000) ;//array(rgb(230,240,250),rgb(0,192,250));
FCheckWidth := 16;
FExpandWidth := 12;
FBasePos := 10;
@ -712,9 +766,9 @@ type TcustomTreeCtlNode = class(tsluibase) //
**}
ow := Owner;
if not ow then return;
cvs.Pen.Color := 0x323232;//rgb(50,50,50);
cvs.Pen.style := PS_SOLID;
cvs.Pen.width := 1;
//cvs.Pen.Color := 0x323232;//rgb(50,50,50);
//cvs.Pen.style := PS_SOLID;
//cvs.Pen.width := 1;
inv := 3;
BasePos := FBasePos+x;
FCheckPos := BasePos;
@ -722,21 +776,22 @@ type TcustomTreeCtlNode = class(tsluibase) //
for i := 1 to Hierarchy do
BasePos += FHierarchyWidth;
cbase := BasePos;
itc := 0;
//itc := 0;
ExpWidth := FExpandWidth;
ifsel := false;
if self=ow.CurrentNode then
begin
ifsel := true;
cvs.brush.Color := FFocusColor[ow.hasFocus()];
cvs.brush.Color := ow.selectionColor;//FFocusColor[ow.hasFocus()];
end else
cvs.brush.Color := ow.Color;
if fitemcountflg then
begin
itc := true;
//itc := true;
BasePos += inv;
FExpandPos := BasePos;
DrawExpand(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
//DrawExpand(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
dexpinfo := array(cvs,BasePos,array(x,y,w,h),ExpWidth-2,FExpanded);
BasePos += ExpWidth;
end else //else ExpWidth := 0;
begin
@ -780,8 +835,8 @@ type TcustomTreeCtlNode = class(tsluibase) //
cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
if ow.HasLine then
begin
cvs.Pen.Color := 0x969696;
cvs.Pen.style := PS_DOT;
cvs.Pen.Color := ow.LineColor;
cvs.Pen.style := ow.Linestyle;
for i,v in ow.ExecuteCommand("gethierarchybyhandle",self.Handle) do
begin
nx := cbase+FHierarchyWidth *(i-FHierarchy-1)+6;
@ -794,6 +849,8 @@ type TcustomTreeCtlNode = class(tsluibase) //
cvs.MoveTo(array(cbase+ExpWidth,y+h/2));
cvs.LineTo(array(cbase-FHierarchyWidth+6,y+h/2));
end
if dexpinfo then
DrawExpand(cvs,dexpinfo[1],dexpinfo[2],dexpinfo[3],dexpinfo[4]);
end
function MouseUp(o,e);
begin
@ -1528,6 +1585,11 @@ type TcustomTreeCtl = class(ttreelistwnd)
function AfterConstruction();override;
begin
inherited;
fexpandsigntype := tvestPlusMinus;
fexpandsigncolor := 0;
flinecolor := 0x969696;
FselectionColor := 0xfac000;
Linestyle := PS_DOT;
fcountlocker := new tcountkernel();
FSingleExpand := false;
FCheckBox := false;
@ -1649,14 +1711,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
end
function imageChanged();override;
begin
if imageList is class(TCustomImageList)then
begin
FBKItemHeight := ItemHeight;
ItemHeight := imageList.Height+2;
end else
begin
if FBKItemHeight>5 then ItemHeight := FBKItemHeight;
end
changeitemheight();
inherited;
end
function CreateTreeNode();virtual;
@ -1764,15 +1819,33 @@ type TcustomTreeCtl = class(ttreelistwnd)
//fnodecreator := nil;
inherited;
end
procedure FontChanged(Sender:TObject);override;
begin
//if parent then parent.FontChanged(Sender);
changeitemheight();
inherited;
end
function ncpaint(rec);override;
begin
dc := Canvas;
ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0));
dc.pen.color := rgb(171,173,179);
dc.draw("polyline",ls);
end
published //属性
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
property CheckBox:bool read FCheckBox write SetCheckBox;
property HasLine:bool read FHasLine write SetHasLine;
property LineColor:color read Flinecolor write Setlinecolor;
property Linestyle:linestyle read fLinestyle write Setlinestyle;
property OnlyLeafNodeCheckMark read FOnlyLeafNodeCheckMark write FOnlyLeafNodeCheckMark;
//property NodeHierarchyWidth read FNodeHierarchyWidth write SetNodeHierarchyWidth;
property RootNode read GetRootNode;
//property MulSelected read FMulSelected write FMulSelected;
property SingleExpand read FSingleExpand write FSingleExpand;
property expandsigntype:tvexpandsigntype read fexpandsigntype write setexpandsigntype;
property expandsigncolor:color read fexpandsigncolor write setexpandsigncolor;
property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged;
property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging;
property onEmptyNodeExapanding read FonEmptyNodeExapanding write FonEmptyNodeExapanding;
@ -1787,8 +1860,14 @@ type TcustomTreeCtl = class(ttreelistwnd)
//echo FRootItem.Owner,"\r\n";
return FRootItem;
end
private //成员变量
fcountlocker; //锁定changed回调
fexpandsigntype;
fexpandsigncolor;
flinecolor;
fLinestyle;
FselectionColor;
weakref
fnodecreator;
FOnlyLeafNodeCheckMark;
@ -1801,12 +1880,66 @@ type TcustomTreeCtl = class(ttreelistwnd)
FMulSelected;
FMulSelects;
FSingleExpand;
FBKItemHeight;
FRootItem;
FCheckBox;
FHasLine;
FPaintArray;
private //成员方法
function SetselectionColor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if (vn<>FselectionColor) then
begin
FselectionColor := nv;
InvalidateRect(nil,false);
end
end
function Setlinestyle(v);
begin
if (v<>fLinestyle) and (v in array(0,1,2,3,4,5,6)) then
begin
fLinestyle := v;
InvalidateRect(nil,false);
end
end
function Setlinecolor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if vn=flinecolor then return ;
flinecolor := vn;
InvalidateRect(nil,false);
end
function setexpandsigntype(v);
begin
if not(v in array(0,1,2,3)) then return ;
if v=fexpandsigntype then return ;
fexpandsigntype := v;
InvalidateRect(nil,false);
end
function setexpandsigncolor(v);
begin
if not ifnumber(v) then return ;
vn := int(v);
if vn=fexpandsigncolor then return ;
fexpandsigncolor := vn;
InvalidateRect(nil,false);
end
function changeitemheight();
begin
ft := font;
if not ft then return ;
if imageList is class(TCustomImageList)then
begin
ItemHeight := max(imageList.Height,ft.height) +2;
end else
begin
ItemHeight := max(5,ft.height) +2;
end
end
function setcurrentnode(nd);
begin
setsel(nd);

86
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -1902,6 +1902,87 @@ type TPropertyAlign=class(UniObjectMember)
return new TAlign123();
end
end
type TPropertybevelcut=class(UniObjectMember)
function EditType();override;
begin
return "tbevelcut";
end
function Create();
begin
inherited;
end
function CreateInfoOBJ();override;
begin
return new unit(utslvclconstant).tbevelcut();
end
end
type TPropertybevelshape=class(UniObjectMember)
function EditType();override;
begin
return "tbevelshape";
end
function Create();
begin
inherited;
end
function CreateInfoOBJ();override;
begin
r := new unit(utslvclconstant).tbevelshape();
return r;
end
end
type TPropertybevelstyle=class(UniObjectMember)
function EditType();override;
begin
return "tbevelstyle";
end
function Create();
begin
inherited;
end
function CreateInfoOBJ();override;
begin
return new unit(utslvclconstant).tbevelstyle();
end
end
type TPropertylinestyle=class(UniObjectMember)
type tlinestyledata=class
static const PS_SOLID=0x0;static const PS_DASH=0x1;static const PS_DOT=0x2;
static const PS_DASHDOT=0x3;static const PS_DASHDOTDOT=0x4;static const PS_NULL=0x5;
end
function EditType();override;
begin
return "linestyle";
end
function Create();
begin
inherited;
end
function CreateInfoOBJ();override;
begin
return new tlinestyledata();
end
end
type TPropertytvetype=class(UniObjectMember)
type tvetype=class
static const tvestTheme = 0; // use themed sign
static const tvestPlusMinus=1; // use +/- sign
static const tvestArrow=2; // use blank arrow
static const tvestArrowFill=3; // use filled arrow
end
function EditType();override;
begin
return "tvexpandsigntype";
end
function Create();
begin
inherited;
end
function CreateInfoOBJ();override;
begin
return new tvetype();
end
end
type TPropertyText=class(TPropertyString)
function EditType();override;
begin
@ -2401,6 +2482,11 @@ begin
"tpropertyesalign",
"tpropertymbbtnstyle",
"tpropertymbicostyle",
"TPropertytvetype",
"TPropertylinestyle",
"TPropertybevelstyle",
"TPropertybevelshape",
"TPropertybevelcut",
"tpropertycolorlist");
for i,v in types do
begin

12
funcext/tvclib/uwindowsinterface.tsf
View File

@ -502,7 +502,7 @@ type twindowsapi = class()
Function LoadIconA(hd:pointer;n:string):pointer;stdcall;external "User32.dll" name "LoadIconA";
Function LoadIconA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadIconA";
Function DrawTextA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer):integer;stdcall;external "User32.dll" name "DrawTextA";
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA";
Function DrawTextExA(hdc :pointer;txt:string;len:integer;var rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA";
Function DrawFrameControl(DC:pointer; LPRECT: array of integer ; dr1 :integer;dr2:integer):integer;stdcall;external "User32.dll" name "DrawFrameControl";
function DrawEdge(hdc:pointer;var qrc:array of integer;edge:integer;grfFlags:integer):integer;;stdcall;external "User32.dll" name "DrawEdge";
function DrawFocusRect(hDC:pointer; var rect:array of integer):integer;stdcall;external "User32.dll" name "DrawFocusRect";
@ -574,7 +574,9 @@ type twindowsapi = class()
{
https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FGetTextMetrics);k(GetTextMetrics);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true
}
Function GetTextMetricsA(hdc :pointer;TM:pointer):integer;stdcall;external "Gdi32.dll" name "GetTextMetricsA";
Function GetCurrentPositionEx(hdc :pointer;var point:array of integer):integer;stdcall;external "Gdi32.dll" name "GetCurrentPositionEx" keepresident;
Function MoveToEx(hdc :pointer;x:integer;y:integer;var point:array of integer):integer;stdcall;external "Gdi32.dll" name "MoveToEx" keepresident;
Function LineTo(hdc :pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "LineTo" keepresident;
Function TextOutA(hdc :pointer;X:integer;y:integer;txt:string;len:integer):integer;stdcall;external "Gdi32.dll" name "TextOutA";
@ -631,15 +633,18 @@ type twindowsapi = class()
function CreatePolygonRgn(ps:array of integer;len:integer;md:integer):pointer;stdcall;external "Gdi32.dll" name "CreatePolygonRgn";
function CombineRgn(hrgnDest:pointer;hrgnSrc1:pointer;hrgnSrc2:pointer; fnCombineMode:integer):integer;stdcall;external "Gdi32.dll" name "CombineRgn";
function SelectClipRgn(dc:pointer;rgn:pointer):integer;stdcall;external "Gdi32.dll" name "SelectClipRgn";
function GetClipRgn(dc:pointer;var rgn:pointer):integer;stdcall;external "Gdi32.dll" name "GetClipRgn";
function PtVisible(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "PtVisible";
function RectVisible(dc:pointer;rect:array of integer):integer;stdcall;external "Gdi32.dll" name "RectVisible";
function ExcludeClipRect(hdc:pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;):integer;stdcall;external "Gdi32.dll" name "ExcludeClipRect";
function SetWindowOrgEx(hdc:pointer;x:integer;y:integer;var lppt: array of integer):integer;stdcall;external "Gdi32.dll" name "SetWindowOrgEx";
function SetViewportOrg(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrg";
function SetViewportOrgEx(dc:pointer;x:integer;y:integer;var pt:array of integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrgEx";
function GetViewportOrgEx(dc:pointer;var pt:array of integer):integer;stdcall;external "Gdi32.dll" name "GetViewportOrgEx";
Function FillRgn(dc:pointer;rgn:pointer;br:pointer):integer;stdcall;external "Gdi32.dll" name "FillRgn";
Function SetTextAlign(dc:pointer;fMode:integer):integer;stdcall;external "Gdi32.dll" name "SetTextAlign";
Function SetWorldTransform(dc:pointer;lpXform:pointer):integer;stdcall;external "Gdi32.dll" name "SetWorldTransform";
Function GetWorldTransform(dc:pointer;lpXform:pointer):integer;stdcall;external "Gdi32.dll" name "GetWorldTransform";
Function SetGraphicsMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetGraphicsMode";
Function GetGraphicsMode(dc:pointer):integer;stdcall;external "Gdi32.dll" name "GetGraphicsMode";
Function SetMapMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetMapMode";
@ -734,10 +739,6 @@ begin
begin
g_windows_proc_handle := makeinstance(thisfunction(tslvclproc));
end
try
SetProcessDpiAwareness(2); //shez dpi¸ÐÖª
except
end
end
function uninit();//жÔØ
begin
@ -748,7 +749,6 @@ begin
g_windows_proc_handle := nil;
end
end
function SetProcessDpiAwareness(v:integer):pointer;stdcall; external "Shcore.dll" name "SetProcessDpiAwareness";
initialization
init();
finalization

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.