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

更新界面库，以及tsl64

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files
designer/gettsleditorstart.tsf
+1
View File
@@ -1,6 +1,7 @@
//启动tsl编辑器
//20230421 整理代码
uses tslvcl;
setprocessdpiawareness(2);
deletefuncacheini(); //清空缓存
ops := ""; //待打开文件
GLobal G_OpenHostory;
designer/gettslvcldesignerstart.tsf
+1
View File
@@ -2,6 +2,7 @@
tsl界面设计器启动程序
}
uses tslvcl,utslvclDesigner;
setprocessdpiawareness(2);
deletefuncacheini();
isdebug := false;
willopen := "";
designer/teditorform.tsf
+2
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
designer/udesignerproject.tsf
+5 -6
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
@@ -385,7 +385,7 @@ type TProjectView = class(TVCForm) //
FTreeTool.ImageList := imgs;
//**************目录树筛选功能***********************************
FFilter := new TEdit(self);
FFilterList := new TListBox(self);
FFilterList := new TListBox(self);
FFilterList.color := 0xdcF8ff;
FFilterList.visible := false;
FFilterList.WsPopUp := TRUE;
@@ -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();
designer/utslcodeeditor.tsf
+11 -1
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
designer/utslsynmemo.tsf
+7 -3
View File
@@ -2164,8 +2164,8 @@ type TTsfFileParser = class() //
FFileNames[fn] := pfn;
if ifstring(d) and d=flt then
begin
ReadParseredFile(fn);
return ;
if ReadParseredFile(fn,nil,pfn) then
return ;
end
if readFile(rwRaw(),"",pfn,0,sz,rdd) then
begin
@@ -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
designer/utslvcldcomponents.tsf
+101 -9
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
//控件树节点
@@ -1461,13 +1479,20 @@ end
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),
designer/utslvcldebuger.tsf
+3 -3
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
designer/utslvcldesigner.tsf
+57 -1
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;
designer/utslvcldesignerresource.tsf
+25
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
designer/utslvcldpropertytypes.tsf
+264 -18
View File
@@ -312,7 +312,7 @@ type TGridCellEditList = class(TGridCellEditWithButton)
dlist.height := 250;
dlist.left := dn[0];
dlist.top := dn[1];
dlist.OnClickSelected := thisfunction(OnvSelected);
dlist.OnClickSelected := thisfunction(OnvSelected);
dlist.SetSelectedByValue(d["value"]);
//dlist.visible := true;
dlist.show();
@@ -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,18 +398,23 @@ 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;
for i := 0 to List.count-1 do
begin
if v=list[i].name then
if ifobj(v) then v := v.name;
if ifstring(v) then
begin
for i := 0 to List.count-1 do
begin
vi := list[i];
break;
if v=list[i].name then
begin
vi := list[i];
break;
end
end
end
end
inherited SetSelectedByValue(vi);
end
function additem(v);override;
@@ -1725,13 +1734,16 @@ 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);
grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Result);
end
end
function CellDrawLabel(dc,rect,d);override;
@@ -1744,8 +1756,9 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor)
end
function CellLeave();override;
begin
Fcpok := false;
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;
@@ -3248,7 +3259,8 @@ type TMultiSelectCell = class(TGridCellEditWithButton)
FPanel;
FI;
FJ;
FCellv;
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();
FCellv := array();
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)
@@ -3419,7 +3440,120 @@ type TGridCellTabAlignEdit = class(TOneSelectCell,TPropertyTabAlign)
begin
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),