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

编辑器 

优化
This commit is contained in:
JianjunLiu 2022-07-15 22:50:46 +08:00
parent 8c69761acc
commit d833e12ca6
11 changed files with 325 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
designer/tslvcldesigner.tsf
View File

@ -885,9 +885,9 @@ type TVclDesigner = class(tvcform)
end
mx := 0;
for i,v in clc do mx := max(mx,v);
height := (integer(mx*32/twidth)+1)*32+60+30;
height := (integer(mx*32/twidth)+1)*32+60+30+24;
end else
height := 90+32;
height := 90+32+24;
end
function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串
@ -1147,21 +1147,18 @@ type TVclDesigner = class(tvcform)
("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile),
"bitmap":getcreateprojectbmpinfo()),
("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj),
"bitmap":GetHostroyBimp())
,
("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),
"bitmap":getwrapprojectbmpinfo()
)
"bitmap":GetHostroyBimp()),
//("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo())
)
),
("type":"menu","caption":"运行","items":(
("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu",
"bitmap":getrunbmpinfo()
),
("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu",
"bitmap":getstopbmpinfo()),
("type":"menu","caption":"调试运行","onclick":thisfunction(debugproject)),
{$ifdef linux}
("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
{$else}
("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行
{$endif}
)),
("type":"menu","caption":"工具","items":(
@ -1850,9 +1847,46 @@ type TVclDesigner = class(tvcform)
FImageList := new TDesigImageList(self);
FTree.Imagelist := FImageList;
//******************toolbar ***************
{fdebugtoolbar := new TToolBar(self);
btns := FProjectManager.FTslEditer.getdbugtoolbtns();
idx := 0;
for i,v in btns do
begin
if idx = 0 then fdebugtoolbar.ImageList := v.parent.ImageList;
idx++;
if v.caption = "添加/删除断点F5" then continue;
v.parent := fdebugtoolbar;
v._tag := v.onclick;
v.onclick := function(o,e)begin
cp := o.caption;
CallMessgeFunction(o._tag,o,e);
if cp<>"终止" then
begin
FProjectManager.ShowEditor();
end
end;
end }
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := array( tlbar.getbtnbyindex(1),tlbar.getbtnbyindex(2));
for i,v in savebtn do //处理一下保存工程
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
tlbar.parent := self;
FToolBars := new TDesignertoolbars(self);
FToolBars.parent := self;
FToolBars.Imagelist := FImageList;
FToolBars.Font.width := 9;
FToolBars.Font.height := 18;
addtoolbuttons();
//************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self);
@ -1861,6 +1895,10 @@ type TVclDesigner = class(tvcform)
ic := new Ticon();
ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo()));
self.FormICon := ic;
{fdebugtoolbar.Align := alnone;
fdebugtoolbar.left := FToolBars.Flabelcharlen* 10;
fdebugtoolbar.top := 0;
fdebugtoolbar.parent := FToolBars;}
//文件打窗口
@ -7307,16 +7345,19 @@ type TDesignertoolbars = class(TPageControl)
FToolbars;
FLabels ;
fimg;
function SetImageList(im);
begin
fimg := im;
end
public
Flabelcharlen;
function Create(AOwner);override;
begin
inherited;
align := alClient;
FToolbars := array();
Flabelcharlen := 0;
end
Procedure Notification(AComponent,Operation);virtual;
begin
@ -7362,13 +7403,13 @@ type TDesignertoolbars = class(TPageControl)
begin
st := new TTabSheet(self);
st.caption := t;
tb := new ttoolbar(self);
tb.align := alClient;
if t<>"非点击添加控件" then
begin
st.parent := self;
tb.parent := st;
Flabelcharlen+= length(t)+2;
end
tb.imagelist := fimg;
FToolbars[t] := tb;

4
designer/udesignerproject.tsf
View File

@ -1469,7 +1469,7 @@ type TProjectView = class(TVCForm) //
FOpenBtn;
FInput;
FScriptHandle;
FTslEditer;
FTmfParser;
FTslParser;
FTreeTool;
@ -1487,6 +1487,8 @@ type TProjectView = class(TVCForm) //
FAddMenuTsf;
FAddMenuTsl;
FOpenMenu;
public
FTslEditer;
end
type TTslEditer = class(TEditer)

45
designer/utslcodeeditor.tsf
View File

@ -1748,21 +1748,29 @@ type TEditer=class(TCustomcontrol) //
dbgbtns := array();
for i,v in imgs do
begin
bmp.Readvcon(HexFormatStrToTsl(v));
FImages.addbmp(bmp);
bt := new TToolButton(self);
FToolbtns[i]:= bt;
if v=0 then
begin
bt.stylesep := true;
end else
begin
bmp.Readvcon(HexFormatStrToTsl(v));
FImages.addbmp(bmp);
bt.OnClick := thisfunction(ToolClick);
bt.Caption := i;
bt.imageid := id;
id++;
end
BT.parent := FToolbar;
if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then
begin
dbgbtns[i]:= bt;
end
end
FImages.DrawBimpFirst := true;
Fdbgbtns := dbgbtns;
FTslDebug.addbtns(dbgbtns);
FToolbar.ImageList := FImages;
FInfoShowWnd.Visible := false;
@ -2111,6 +2119,14 @@ type TEditer=class(TCustomcontrol) //
begin
return FFindWnd.GetHistory();
end
function getdbugtoolbtns();
begin
return Fdbgbtns;
end
function gettoolbar();
begin
return FToolbar;
end
function ShowLogWnd(flg);
begin
n :=(ifnil(flg)or flg)?true:false;
@ -2598,13 +2614,14 @@ type TEditer=class(TCustomcontrol) //
begin
if filenameIsTheSame(v,vi)then
begin
fcadd := false;
//fcadd := false;
FOpenHistory.Splice(i,1); //删除原来的记录
break;
end
end
if fcadd then
begin
FOpenHistory.Push(v);
FOpenHistory.push(v);
if FOpenHistory.Length()>30 then FOpenHistory.shift();
end
end
@ -2651,7 +2668,8 @@ type TEditer=class(TCustomcontrol) //
end
if FOpenHistory.Length()>0 then
begin
FHistoryWnd.SetData(FOpenHistory.Data);
d := FOpenHistory.Data;
FHistoryWnd.SetData(d);
InitShowWndPos(FHistoryWnd,"history",100,100);
FHistoryWnd.ShowModal();
end
@ -2924,15 +2942,24 @@ type TEditer=class(TCustomcontrol) //
if not(FPageEditer and FPageEditer.parent=self)then return;
rr := ClientRect;
r := rr;
if FToolbar.Parent = self then
begin
htoolbar := true;
end
if htoolbar then
begin
th := FToolbar.CalcHeightFixWidth(rr[2]-rr[0]);
//FToolbar.Height := th;
r[3]:= r[0]+th;
FToolBar.SetBoundsRect(r);
end
r := rr;
r[1]:= r[3]-FStatus.Height;
FStatus.SetBoundsRect(r);
rr := rr;
if htoolbar then
begin
rr[1]:= FToolbar.Height+1;
end
rr[3]:= rr[3]-FStatus.Height-1;
{if ffolderdlg and ffolderdlg.Visible then
begin
@ -2946,7 +2973,7 @@ type TEditer=class(TCustomcontrol) //
begin
r := rr;
r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.6));
r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.8)); //0.6 靠扩大到 0.8
rr[3]:= r[1]-1;
{fwd := min(FInfoShowWnd.Width,integer(r[2] * 0.6)); //右侧
@ -3825,6 +3852,7 @@ type TEditer=class(TCustomcontrol) //
if ifobj(c[0])and ifobj(c[1])then return array(CreateObject(c[0],ow),CreateObject(c[1],ow));
end
end
Fdbgbtns;
static FSynClasses;
FCodeFormatInfo;
FTslChmHelp;
@ -4979,7 +5007,7 @@ type TMouseMoveList=class(TListBox)
function getItemText(i);override;
begin
r := inherited;
return " "+r;
return "["$ i $"]" $ r;
end
function PaintIdx(idx,rc_,cvs);virtual;
begin
@ -5068,6 +5096,7 @@ B85C4055CF250DD2251015779AC1ABF4E121390D3FE5BFF436D9BA680DFE3B533
AE42608200";
r["快捷键说明"]:= getquickkeybitmapinfo();
r["代码地图(alt+m)"]:= gettslcodemapbitmapinfo();
r["分隔符"] := 0;
return r union dbugicos();
end
function dbugicos();

42
designer/utslvcldebuger.tsf
View File

@ -262,10 +262,12 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj)
end
type TTslDebuga=class(TCustomControl)
private //成员变量
//Frundirect;
FRuningfile; //执行脚本文件名
FRuningItem; //执行的pageitem
FCurrentgotoitem; //当前运行到的pageitem
FDebughandle; //调试的句柄
Fdebugedwhandle ;//调试的窗口
FDebugExe; //调试功能的exe
FConnectchannel; //调试的 通道
FDebugaddr; //地址
@ -617,6 +619,7 @@ type TTslDebuga=class(TCustomControl)
function Create(AOwner);
begin
inherited;
//Frundirect := false;
FCmdHistory := array();
FCmdHistoryid := 0;
FCmdHistorycount := 10;
@ -678,6 +681,26 @@ type TTslDebuga=class(TCustomControl)
dbgunsetbreak(FConnectchannel,usr,n,idx+1);
end
end
function GetWindowHandleByPID(dwProcessID,api) //通过进程ID获取窗口句柄
begin
h := api.GetTopWindow(0);
while(h) do
begin
pid := 0;
dwTheardId := api.GetWindowThreadProcessId(h,pid);
if(dwTheardId <> 0)then
begin
if(pid=dwProcessID)then
begin
// here h is the handle to the window
while(api.GetParent(h)<> 0) do h := api.GetParent(h);
return h;
end
end
h := api.GetNextWindow(h,2);
end
return 0;
end
function Dbgtooldo(o,e)
begin
cp := o.Caption;
@ -699,6 +722,10 @@ type TTslDebuga=class(TCustomControl)
"暂停":
begin
ExecuteCommand("dbgpause");
if Fdebugedwhandle then
begin
_Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0);
end
end
"进入":
begin
@ -721,6 +748,15 @@ type TTslDebuga=class(TCustomControl)
toolbtnState("继续");
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
ExecuteCommand("dbgrun");
{$ifdef linux}
{$else}
if not Fdebugedwhandle then
Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(FDebughandle),_wapi);
if Fdebugedwhandle then
begin
_wapi.SetForegroundWindow(Fdebugedwhandle);
end
{$endif}
end
"终止":
begin
@ -757,7 +793,7 @@ type TTslDebuga=class(TCustomControl)
FConnectchannel := 0;
g_tsldbgcallback_handle := nil;
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
FDebughandle := 0;
FDebughandle := 0;Fdebugedwhandle := 0;
toolbtnState("停止");
return;
end
@ -841,6 +877,7 @@ type TTslDebuga=class(TCustomControl)
FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",stk[0,"LINE"]-1);
end
end
//_wapi.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop
return;
end
"detached":
@ -1116,6 +1153,7 @@ type TTslDebuga=class(TCustomControl)
g_tsldbgcallback_handle := nil;
fdbgselwnd := nil;
end
//property rundirect read Frundirect write Frundirect;
private
function getdefaultdbger();
begin
@ -1403,7 +1441,7 @@ type TTslDebuga=class(TCustomControl)
if FDebughandle then
begin
SysTerminate(-1,FDebughandle);
FDebughandle := 0;
FDebughandle := 0; Fdebugedwhandle := 0;
end
end
function parseriteminfo(item,idx,n,usr);

25
funcext/tvclib/tslvcl.tsf
View File

@ -892,6 +892,11 @@ type TPanel=class(TScrollingWinControl) //
p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
//p.exstyle := 0x101;
end
function paint();override;
begin
inherited;
drawdesigninggrid();
end
function publishs();override;
begin
return array("name","align","anchors","caption","enabled","cursor","font",
@ -1280,9 +1285,10 @@ type TVCForm = class(TScrollingWinControl)
if cd is class(TComponent)then return Controls.indexof(cd)<0;
return true;
end
function paint();override;
function Paint();override;
begin
inherited;
drawdesigninggrid();
end
function WMSYSCOMMAND(o,e):WM_SYSCOMMAND;override;
begin
@ -1503,6 +1509,11 @@ type TpanelForm=class(tpanel)
FWidth := wd;
wspopup := true;
end
function Paint();override;
begin
inherited;
drawdesigninggrid();
end
function SetDesigning(f,fc);override;
begin
if f then wspopup := true;
@ -1522,6 +1533,7 @@ type TDCreatePanel=class(TpanelForm)
inherited;
Loader.LoadFromTfm(self(true));
end
end
//°´Å¥
@ -2139,8 +2151,8 @@ type tmemo = class(TSynMemoNorm)
function publishs();override;
begin
return array("name","font",
"popupmenu","visible",
"height","width","anchors","left","top",
"popupmenu","visible","anchors","align",
"height","width","left","top",
"text","readonly",
"tabspace","onmousewheel","onmousemove","onpopupmenu",
"onmousedown","onmouseup",
@ -3526,7 +3538,7 @@ type TTabSheet = class(TCustomControl)
public
function paint();override;
begin
drawdesigninggrid();
end
function DesigningMove();override;
begin
@ -4163,6 +4175,11 @@ type TPairSplitterSide=class(TCustomControl)
begin
return false;
end
function paint();override;
begin
inherited;
drawdesigninggrid();
end
function DesigningSizer();override;
begin
return false;

24
funcext/tvclib/twincontrol.tsf
View File

@ -1830,6 +1830,30 @@ end
if HandleAllocated()then ControlCreateWnd();
end
protected
function drawdesigninggrid();
begin
if csDesigning in ComponentState then
begin
cv := canvas;
if not(cv.HandleAllocated()) then return ;
rc := ClientRect;
dx := 20;
dy := 20;
x := 0;
y := 0;
c := 0;
while y<rc[3] do
begin
y+=dx;
x := 0;
while x<rc[2] do
begin
x+=dx;
cv.SetPixel(array(x,y),c);
end
end
end
end
function ControlCreateWnd();
begin
for i := 0 to FControls.count-1 do

22
funcext/tvclib/ugtkinterface.tsf
View File

@ -974,6 +974,24 @@ type tsgtkapi = class(tgtkapis)
gtk_object_set_data(hdc,"text.color",col);
return true;
end
Function SetPixel(dc,x,y,colr);
begin
if not dc then return ;
if ifnumber(x) and ifnumber(y) then
begin
pc := colr;
MoveToEx(dc,x,y);
pc := gtk_object_get_data(dc,"pen.color");
pw := gtk_object_get_data(dc,"pen.width");
gtk_object_set_data(dc,"pen.color",colr);
gtk_object_set_data(dc,"pen.width",2);
LineTo(dc,x+1,y+1);
gtk_object_set_data(dc,"pen.color",pc);
gtk_object_set_data(dc,"pen.width",pc);
return 1;
end
end
Function FillRect(dc:pointer;rec:array of integer;br:pointer):integer;
begin
if not dc then return ;
@ -2558,10 +2576,10 @@ type tsgtkapi = class(tgtkapis)
begin
end;
function SetForegroundWindow(hwd :pointer):integer;
function Shell_NotifyIconA(dwMessage:integer; lpData:pointer):integer;
begin
end
function Shell_NotifyIconA(dwMessage:integer; lpData:pointer):integer;
function SetForegroundWindow(hwd :pointer):integer;
begin
end
function BringWindowToTop(hwd :pointer);

25
funcext/tvclib/utslvclgdi.tsf
View File

@ -7,6 +7,7 @@ interface
uses cstructurelib,utslvclmemstruct,utslvclauxiliary,utslvclbase;
function GetTextWidthAndHeightWidthFont(s,f,mul);
function getdrawablebitmap(w,h,bmp);
type TGdi = class(TSLUIBASE)
private
static GDICache;
@ -2660,11 +2661,14 @@ type TcustomCanvas = class(TSLUIBASE)
@return(tcustombitmap|nil) 成功返回位图 %%
**}
r := nil;
{$ifdef linux}
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;
if not FHDC then FHDC := _wapi.CreateCompatibleDC(0);
if not FHDC then return r;
bthandle := _wapi.CreateCompatibleBitmap(FSHDC2,w,h);
bthandle := _wapi.CreateCompatibleBitmap(_wapi.GetDC(0),w,h);
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);
@ -2679,6 +2683,9 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明)文本旋转%%
@param(trans)(array) array(cos,-sin,sin,cos,x,y)%%
**}
{$ifdef linux}
return r;
{$endif}
_xformobj._setvalue_("em11",trans[0]);
_xformobj._setvalue_("em12",trans[1]);
_xformobj._setvalue_("em21",trans[2]);
@ -2996,6 +3003,22 @@ begin
cv.handle := cv._wapi.CreateCompatibleDC(0);
return cv;
end
function getdrawablebitmap(w,h,bmp);
begin
{$ifdef linux}
return 0;
{$endif}
if w>1 and h>1 then
begin
cv := static GetOneCanvas();
api := cv._wapi;
bmp := new TcustomBitmap();
bhd :=api.CreateCompatibleBitmap(api.GetDC(0),w,h);
bmp.handle := bhd;
api.SelectObject(cv.handle,bhd);
return cv;
end
end
initialization
sinitgidplus();
class(tcustomimage).sinit();

126
funcext/tvclib/utslvclstdctl.tsf
View File

@ -2569,9 +2569,9 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function MouseUp(o,e);override;
begin
if FIsMouseDown then
if FIsMouseDown then //已经按下过
begin
_wapi.clipcursor(ps);
_wapi.clipcursor(ps); //解锁光标
FIsMouseDown := false;
selchange := 0;
case FMultisel of
@ -3552,6 +3552,7 @@ type TcustomToolButton=class(tcomponent)
FImageId :=-1; //imageid
FEnabled := true; //有效 可以点击
FVisible := true; //可见
FStylesep := false;
end
function ExecuteCommand(cmd,d);override;
begin
@ -3598,7 +3599,7 @@ type TcustomToolButton=class(tcomponent)
end
function publishs();override;
begin
return array("name","caption","enabled","imageid","visible","onclick","popupmenu");
return array("name","caption","enabled","stylesep","imageid","visible","onclick","popupmenu");
end
function Recycling();override;
begin
@ -3631,6 +3632,7 @@ type TcustomToolButton=class(tcomponent)
property Action:taction read GetAction write SetAction;
property ShortCut read getShortCut write SetShortCut;
property PopupMenu:tpopupmenu read FPopupMenu write FPopupMenu;
property stylesep:bool read FStylesep write setstylesep;
{**
@param(OnClick)(function[o:TToolButton;e:tuieventbase]) 点击消息 %%
@param(Caption)(string) 标题 %%
@ -3639,7 +3641,17 @@ type TcustomToolButton=class(tcomponent)
@param(Visible)(bool) 是否可见 %%
**}
private
FStylesep;
FShortCut;
function setstylesep(v);
begin
nv := v?true:false;
if nv<>FStylesep then
begin
FStylesep := nv;
if FToolbar then FToolbar.BtnChanged();
end
end
function getShortCut();
begin
return formatshortcut(FShortCut);
@ -3913,6 +3925,10 @@ type TcustomToolBar=class(TCustomControl)
**}
InsertButton(btn);
end
function getbtnbyindex(idx);
begin
return FButtons[idx];
end
function SetBtnIndex(btn,idx);
begin
{**
@ -4018,6 +4034,50 @@ type TcustomToolBar=class(TCustomControl)
**}
EndUpdate();
end
function Paint();override;
begin
c := canvas;
for i := 0 to FButtons.length()-1 do
begin
bi := FButtons[i];
if not(bi.Visible)then continue;
ci := FBtnRects[i];
if not ifarray(ci)then return;
if FMouseDownIdx=i then
begin
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK);
end else
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);
igslist := ImageList;
if igslist is class(TCustomImageList)then
begin
igid := bi.ImageId;
if igid >= 0 and igid<igslist.ImageCount then
begin
if bi.Enabled then igslist.draw(igid,c,ci[0]+2,ci[1]+2,nil);
else igslist.draw(igid,c,ci[0]+2,ci[1]+2,ILC_COLOR4);
end
end
end
end
function DoEndUpDate();override; //锁定刷新释放
begin
if not(IsUpDating())then
begin
if FWillModifyToolbar then
begin
FWillModifyToolbar := false;
DoControlAlign();
if Parent then Parent.DoControlAlign();
end
end
inherited;
end
function DoControlAlign();override;
begin
CalcButtonsRect();
end
function CalcHeightFixWidth(w);
begin
{**
@ -4105,49 +4165,6 @@ type TcustomToolBar=class(TCustomControl)
return((frac(nt)>0)?(integer(nt)+1):(nt)) * (imgw+1)+bw;
return(integer(bct/rct)+1) * (imgw+1)+bw;
end
function Paint();override;
begin
c := canvas;
for i := 0 to FButtons.length()-1 do
begin
bi := FButtons[i];
if not(bi.Visible)then continue;
ci := FBtnRects[i];
if not ifarray(ci)then return;
if FMouseDownIdx=i then
begin
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK);
end else
c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH);
igslist := ImageList;
if igslist is class(TCustomImageList)then
begin
igid := bi.ImageId;
if igid >= 0 and igid<igslist.ImageCount then
begin
if bi.Enabled then igslist.draw(igid,c,ci[0]+2,ci[1]+2,nil);
else igslist.draw(igid,c,ci[0]+2,ci[1]+2,ILC_COLOR4);
end
end
end
end
function DoEndUpDate();override; //Ëø¶¨Ë¢ÐÂÊÍ·Å
begin
if not(IsUpDating())then
begin
if FWillModifyToolbar then
begin
FWillModifyToolbar := false;
DoControlAlign();
if Parent then Parent.DoControlAlign();
end
end
inherited;
end
function DoControlAlign();override;
begin
CalcButtonsRect();
end
function IndexOfBtn(btn);
begin
{**
@ -4221,6 +4238,7 @@ type TcustomToolBar=class(TCustomControl)
FTimer.Stop();
FTipWnd.Visible := false;
end
function CalcButtonsRect();
begin
if(IsUpDating())then
@ -4254,20 +4272,30 @@ type TcustomToolBar=class(TCustomControl)
if y+imgh>rc[3]then
begin
if rct=0 then
begin
if bi.stylesep then
begin
FBtnRects[i]:= array(0,0,0,0);
end else
begin
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
end
y := 0;
x += imgw+1;
end else
begin
y := 0;
x += imgw+1;
if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
else
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
y += imgh+1;
rct := 1;
end
end else
begin
if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
else
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
y += imgh+1;
rct++;
@ -4287,6 +4315,8 @@ type TcustomToolBar=class(TCustomControl)
begin
if rct=0 then
begin
if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
else
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
x := 0;
y += imgh+1;
@ -4294,12 +4324,16 @@ type TcustomToolBar=class(TCustomControl)
begin
x := 0;
y += imgh+1;
if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
else
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
x += imgw+1;
rct := 1;
end
end else
begin
if bi.stylesep then FBtnRects[i]:= array(0,0,0,0);
else
FBtnRects[i]:= array(x,y,x+imgw,y+imgh);
x += imgw+1;
rct++;

8
funcext/tvclib/uwindowsinterface.tsf
View File

@ -222,8 +222,13 @@ type twindowsapi = class
class function IsWindow(hd:pointer):integer;stdcall;external "User32.dll" name "IsWindow";
class function IsWindowVisible(hd:pointer):integer;stdcall;external "User32.dll" name "IsWindowVisible";
function GetWindow(hd:pointer;cd:integer):pointer;stdcall;external "User32.dll" name "GetWindow";
function GetNextWindow(hd:pointer;cd:integer):pointer;stdcall;external "User32.dll" name "GetNextWindow";
//function GetNextWindow(hd:pointer;cd:integer):pointer;stdcall;external "User32.dll" name "GetNextWindow";
function GetNextWindow(h,cd);
begin
return GetWindow(h,cd);
end
function GetTopWindow(hd:pointer):pointer;stdcall;external "User32.dll" name "GetTopWindow";
function GetWindowThreadProcessId(hd:pointer;var pid :integer):integer;stdcall;external "User32.dll" name "GetWindowThreadProcessId";
function IsChild(hd:pointer;cd:pointer):integer;stdcall;external "User32.dll" name "IsChild";
function RegisterClassExA(wc:pointer):short;stdcall;external "User32.dll" name "RegisterClassExA";
function EnableWindow(wc:pointer;b:integer):integer;stdcall;external "User32.dll" name "EnableWindow";
@ -320,6 +325,7 @@ type twindowsapi = class
function memcpy2(var dst:string;src:pointer;size_t:integer):pointer;cdecl;external "msvcrt.dll" name "memcpy";
function fopen(filename:string; mode:string):pointer;cdecl;external "msvcrt.dll" name "fopen";
function fclose(f:pointer):integer;cdecl;external "msvcrt.dll" name "fclose";
function GetProcessId(h:pointer):integer;stdcall;external "Kernel32.dll" name "GetProcessId";
function LockFile(hFile:pointer; dwFileOffsetLow:integer; dwFileOffsetHigh:integer;nNumberOfBytesToLockLow:integer;nNumberOfBytesToLockHigh:integer):integer;stdcall;external "Kernel32.dll" name "LockFile";
function UnlockFile(hFile:pointer; dwFileOffsetLow:integer; dwFileOffsetHigh:integer;nNumberOfBytesToLockLow:integer;nNumberOfBytesToLockHigh:integer):integer;stdcall;external "Kernel32.dll" name "UnlockFile";
//icon