liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity
tslediter/funcext/tvclib/twincontrol.tsf

2783 lines
85 KiB
Plaintext
Raw Blame History

type TWinControl = class(tcontrol)
///////////平台判断////////
{$ifdef linux}
{$define gtkpaint}
{$define linuxgtk}
{$else}
{$define gdipaint}
{$endif}
uses utslvclauxiliary,utslvclmemstruct,utslvclbase,utslvclevent,utslvclgdi,uvclthreadworker,utslvclaction,utslvclmenu;//,utslvclstdctl;
{**
@explan(说明) 窗口控件 %%
**}
private //成员变量
[weakref] ftrackmenu;
__wstyle; //窗口样式
__wexstyle; //窗口扩展样式
//__wstylestruct; //样式消息结构体
__clientsize; //客户区大小
//__oldclientsize; //旧客户区大小
factivated;
FClientleft;
FClientTop;
FClientWdith;
FClientHeight;
FWsPopUp;
//FTtageDrawItem; //已经移除
FWMNCHITTEST;
FImageList;
//FTRACKMOUSEEVENT;
FHandle:HWND; //窗口句柄
private //窗口相关
FBorderStyle;
FParentWindow:HWND; //父窗口句柄
static FDefaultProc; //windows默认句柄处理
FWndproc; //消息句柄
protected //消息
FDefWndproc; //默认消息句柄
private //时间指针
weakref
FonKillFocus;
FonSetFocus;
foncreated;
FControlStyle; //控件样式
FOnClose;
FOnDesinedsel;
FOnDesigDBLClick;
FOnDesinedRclick;
FOnActivate;
FOnKeyDown;
FOnKeyPress;
fonsyskeydown;
fonsyskeyup;
FOnSysKeyPress;
FOnKeyUp;
factivecontrol;
autoref
FTabStop;
FWsCaption;
FWsSizeBox;
FWsSysMenu;
FWsDlgModalFrame;
private //模态相关
//*******showmodal******************
FModaling;
FModalCode;
FMinWidth;
FMinHeigt;
//Ftagminmaxinfo;
FMaxWidth;
FMaxHeight;
FGtkEventOjbect; //gtkobject
private //窗口属性
function SetMaxWidth(v);
begin
if v>0 and FMaxWidth <> V then
begin
FMaxWidth := v;
end
end
function SetMaxHeight(v);
begin
if v>0 and FMaxHeight <> v then
begin
FMaxHeight := v;
end
end
function SetMinWidth(v);
begin
if v>0 and FMinWidth <> v then
begin
FMinWidth := v;
if FMinWidth>width then width := FMinWidth;
end
end
function SetMinHeight(v);
begin
if v>0 and FMinHeigt <> v then
begin
FMinHeigt := v;
if FMinHeigt>height then height := FMinHeigt;
end
end
function DoModal()
begin
//标识处于模态状态中
if not WsPopUp then
begin
exit;
end
{$ifdef gtkpaint}
if FModaling then exit;
if _wapi.gtk_window_showmodal(self(true))then
begin
FModaling := true;
app := class(tUIglobalData).uigetdata("tuiapplication");
if app then app.run();
end
return FModalCode;
exit;
{$endif}
modp := parent;
{if not(modp is class(TWinControl)) then
begin
return -1;
end }
hWnd := Handle;
FModaling := TRUE;
FMSG := new TTagMSG();
msg := FMSG._getptr_;
//显示自己
_wapi.ShowWindow(hWnd,SW_SHOW);
_wapi.BringWindowToTop(hWnd);
//disable掉父窗口
FModalRootWnd := 0;
inabledlist := array();
inabledlistidx := 0;
if(modp is class(TWinControl))and modp.HandleAllocated()then
begin
hParentWnd := modp.Handle;
while(hParentWnd) do
begin
_wapi.EnableWindow(hParentWnd,FALSE);
inabledlist[inabledlistidx++] := hParentWnd;
wdobj := class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hParentWnd);
if wdobj and wdobj.Modaling then
begin
FModalRootWnd := hParentWnd;
break;
end
hParentWnd := _wapi.GetParent(hParentWnd);
end
end
//接管消息循环
while(FModaling) do
begin
/////////////////////////////////////////////
if(_wapi.PeekMessageA(msg,0,0,0,0x1))then
begin
if FMSG.message=0x12 then
begin
return 1;
end else
begin
_wapi.TranslateMessage(msg);
_wapi.DispatchMessageA(msg);
end
end else
begin
tslprocessmessages(false);
sleep(10);
class(TCustomThreadworker).dispatch();
end
//////////////////////////////////////////
{if (not _wapi.GetMessageA(msg, 0, 0, 0)) then break;
_wapi.TranslateMessage(msg);
_wapi.DispatchMessageA(msg);}
end
//模态已经退出
//恢复父窗口的enable状态
///////////////////////////////////////////////////////////////////////////
for i:= length(inabledlist)-1 downto 0 do
begin
_wapi.EnableWindow(inabledlist[i],TRUE);
end
inabledlist := nil;
{if(modp is class(TWinControl))and modp.HandleAllocated()then
begin
hParentWnd := modp.Handle;
while(hParentWnd) do
begin
_wapi.EnableWindow(hParentWnd,TRUE);
if FModalRootWnd=hParentWnd then break;
hParentWnd := _wapi.GetParent(hParentWnd);
end
end}
///////////////////////////////////////////////////////////////////////
//将自己隐藏
_wapi.ShowWindow(hWnd,SW_HIDE);
return FModalCode;
end
private //窗口样式
function SetWSsizeBox(v);
begin
nv := v?true:false;
if nv <> FWsSizeBox then
begin
FWsSizeBox := nv;
if HandleAllocated()then RecreateWnd();
end
end
function GetWsSysMenu();virtual;
begin
return FWsSysMenu;
end
function SetWsSysMenu(v);virtual;
begin
nv := v?true:false;
if nv <> FWsSysMenu then
begin
FWsSysMenu := nv;
if HandleAllocated()then RecreateWnd();
end
end
function SetWsDlgModalFrame(v);virtual;
begin
nv := v?true:false;
if nv <> FWsDlgModalFrame then
begin
FWsDlgModalFrame := nv;
if HandleAllocated()then
begin
RecreateWnd();
end
end
end
protected
function SetWsPopUp(v);virtual;
begin
nv := v?true:false;
if nv <> FWsPopUp then
begin
factivated := false;
FWsPopUp := nv;
vb := Visible;
if HandleAllocated()then
begin
RecreateWnd();
if vb and nv then show(); //处理顶层窗口的显示
end
end
end
function GetWsPopUp();virtual;
begin
return FWsPopUp;
end
private
function CompareRect(orect,nrect);
begin
return orect=nrect;
end
function GetWsCaption(v);virtual;
begin
return FWsCaption;
end
function SetWsCaption(v);virtual;
begin
nv := v?true:false;
if nv <> FWsCaption then
begin
FWsCaption := nv;
if HandleAllocated()then RecreateWnd();
end
end
function GetHandle(); //type_twinctrol
begin
//if not HandleAllocated then DebugLn('TWinControl.GetHandle Creating handle on the fly: ',DbgSName(Self));
HandleNeeded();
return FHandle;
end;
procedure SetHandle(NewHandle); //type_twinctrol
begin
if {NewHandle and}not(FHandle)then FHandle := NewHandle;
//if (NewHandle=0) and (AnsiCompareText(ClassName,'TPAGE')=0) then
// RaiseGDBException('TWincontrol.SetHandle');
//FHandle:=NewHandle;
//InvalidatePreferredSize();
end;
function SetTabStop(v);
begin
nv := V?true:false;
if nv <> FTabStop then
begin
FTabStop := nv;
if HandleAllocated()then
begin
if nv then appendwstyle(WS_TABSTOP);
else minuswstyle(WS_TABSTOP);
end
end
end
function GetControlCount():Integer; //type_twinctrol
begin
return FControls.Count();
end;
procedure SetParentWindow(const AValue:HWND); //type_twinctrol
begin
{**
@ignore(忽略) %%
**}
if(ParentWindow=AValue)or Assigned(Parent)then Exit;
FParentWindow := AValue;
if HandleAllocated()then
begin
if(AValue <> 0)then //LCLIntf.SetParent(Handle, AValue)
else DestroyHandle();
end
UpdateControlState();
end
protected
function SetParentFont(v:bool);override;
begin
if inherited then
begin
InvalidateRect(nil,false);
end
end
function SetImageList(v);
begin
if FImageList=v then exit;
if FImageList is class(tcustomcontrolimagelist) then
begin
ti := FImageList;
FImageList := nil;
ti.deleteControl(self);
end
FImageList := v;
if v is class(tcustomcontrolimagelist) then v.addControl(self);
ImageChanged();
end
class function getwndbyhwnd(hwnd); //type_twinctrol
begin
return class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
end
class function registerhandle(handle,o); //type_twinctrol
begin
//注册对象 %%
return class(tUIglobalData).uigetdata("TGlobalComponentcache").registerhandle(handle,o);
end
class function unregisterhandle(handle); //type_twinctrol
begin
//删除对象 %%
return class(tUIglobalData).uigetdata("TGlobalComponentcache").unregisterhandle(handle);
end
class function sinit();override;
begin
{**
@explan(说明)初始化 %%
**}
if ifnil(FDefaultProc)then FDefaultProc := _wapi.getDefWindowProcA() ;
end
function SetBorder(v);override; //type_twinctrol
begin
nv := v?true:false;
if nv <> Border then
begin
inherited;
if nv then appendwstyle(WS_BORDER);
else minuswstyle(WS_BORDER);
Refresh();
end
end
procedure CreateHandle();virtual; //type_twinctrol
begin
if csCreating in ControlState then return;
if(not HandleAllocated())then
begin
includestate(ControlState,csCreating);
CreateWnd();
excludestate(ControlState,csCreating);
end
end;
function InitializeWnd();virtual; //type_twinctrol
begin
{**
@explan(说明) 窗口句柄初始化,在该函数设置窗口句柄的一些信息 %%
**}
//背景这些处理
if HandleAllocated()then
begin
//Canvas.Handle := _wapi.GetDC(self.Handle);
if(Parent is class(TWinControl))and Parent.HandleAllocated()then
begin
//if Align<>alNone then
Parent.DoControlAlign();
end
//ImageChanged();
// "id:",self.caption,_wapi.GetWindowLongPtrA(FHandle,GWLP_ID);
end
end
function GetBorderStyle();
begin
return FBorderStyle;
end
function SetBorderStyle(NewStyle);virtual;
begin
if FBorderStyle=NewStyle then exit;
if FBorderStyle in array(bsNone,bsSingle)then
begin
FBorderStyle := NewStyle;
if FBorderStyle=bsNone then
begin
minuswexstyle(WS_EX_CLIENTEDGE);
end else
appendwexstyle(WS_EX_CLIENTEDGE);
end
end
function CreateParams(p);virtual; //type_twinctrol
begin
{**
@explan(说明)构架窗口句柄使用 %%
@param(p)(var TCreateParams) 变参返回 %%
**}
if not(p is class(TCreateParams))then p := new TCreateParams();
p.Caption := Caption;
//p.Style := WS_CHILD .| WS_CLIPSIBLINGS .| WS_CLIPCHILDREN ;
p.Style := WS_CHILD;
if FWsPopUp then
begin
p.Style := WS_POPUP;
end else
begin
p.Style := WS_CHILD;
end
//p.style .|= WS_CAPTION; //WS_SYSMENU .|
if WsCaption then p.style .|= WS_CAPTION;
if FWsSysMenu then P.Style .|= WS_CAPTION .| WS_SYSMENU;
if FWsSizeBox then p.style .|= WS_SIZEBOX;
if Border then p.Style := p.Style .| WS_BORDER;
if csAcceptsControls in FControlStyle then p.ExStyle := p.ExStyle .| WS_EX_CONTROLPARENT;
if BorderStyle=bsSingle then p.ExStyle := p.ExStyle .| WS_EX_CLIENTEDGE;
if WSDlgModalFrame then
begin
p.ExStyle .|= WS_EX_DLGMODALFRAME;
end
if TabStop then p.Style .|= WS_TABSTOP;
//op := parent;
if not(Enabled)then p.Style .|= WS_DISABLED;
if Visible then p.Style .|= WS_VISIBLE;
if Parent is class(TWinControl)then //if Parent.HandleAllocated() then
p.WndParent := Parent.Handle;
else p.WndParent := ParentWindow;
p.X := Left;
p.Y := Top;
p.Width := Width;
p.Height := Height;
p.happ := happ;
p.Style .|= WS_CLIPSIBLINGS .| WS_CLIPCHILDREN;
p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
end
procedure RealSetText(Value:TCaption);override; //type_twinctrol
begin
{**
@explan(说明) 设置标题 %%
@param(value)(string) 标题 %%
**}
if ifstring(Value)and(Caption <> Value)then
begin
inherited;
if HandleAllocated()then
begin
_wapi.SetWindowTextA(self.handle,self.Caption);
end
end
end
function createwndclass(p); //type_twinctrol
begin
{**
@param(p)(TCreateParams) 注册窗口类 %%
@explan(说明)注册窗口类 %%
**}
classobj := p.winclass; //new tagWNDCLASSA();
subclass := p.subclass;
uiproc := _wapi.getvclwindowprocA();
dfproc := _wapi.getDefWindowProcA() ;
p.subclasswndproc := dfproc;
tclass := new tagWNDCLASSA();
classobj._setvalue_("lpszclassname",p.WinClassName);
for i,v in classobj._getdata_() do
begin
if i="lpfnwndproc" then tclass._setvalue_(i,uiproc);
else tclass._setvalue_(i,v);
end
regptr := _wapi.GetClassInfoExA(p.happ,p.WinClassName,classobj._getptr_);
if not regptr then
begin
for i,v in tclass._getdata_() do
begin
classobj._setvalue_(i,v);
end
end
if ifstring(p.SubClassName)and p.SubClassName then //存在subclass
begin
tcn := p.SubClassName;
subregptr := _wapi.GetClassInfoExA(p.Happ,tcn,subclass._getptr_);
if subregptr then
begin
p.subclasswndproc := subclass._getvalue_("lpfnwndproc");
if p.subclasswndproc=uiproc then
begin
p.subclasswndproc := dfproc;
end
if not regptr then //窗口没有注册
begin
for i,v in subclass._getdata_() do //填充子窗口信息
begin
if i="lpfnwndproc" then
begin
classobj._setvalue_(i,uiproc);
end else
if i="lpszclassname" then
begin
tcn := p.WinClassName;
classobj._setvalue_(i,tcn);
end else
begin
classobj._setvalue_(i,v);
end
end
end
end
end else //不存在subclass 默认回调为 defaultproc
begin
if p.cstyle then classobj.style := p.cstyle;
p.subclasswndproc := dfproc;
end
if regptr then
begin
if uiproc <> classobj._getvalue_("lpfnwndproc")then
begin
messageboxA("窗口类注册冲突!","错误",1);
end
end else
begin
regptr := _wapi.RegisterClassExA(classobj._getptr_);
end
end
function UpdateControlState(); ////type_twinctrol
begin
end
procedure ChangeBounds(ALeft,ATop,AWidth,AHeight:integer;KeepBase:boolean);override; //type_twinctrol
begin
if ALeft=-32000 or ATop = -32000 then exit ;
if HandleAllocated()then
begin
//_wapi.MoveWindow(self.Handle,ALeft,ATop,AWidth,AHeight,true);
_wapi.SetWindowPos(self.Handle,0,integer(ALeft),integer(ATop),integer(AWidth),integer(AHeight),SWP_NOZORDER .| SWP_NOACTIVATE); //.| SWP_NOACTIVATE
end else
begin
inherited;
//class(tcontrol).ChangeBounds(ALeft, ATop, AWidth, AHeight,KeepBase);
end
end
function SetEnabled(v);override;
begin
inherited;
if HandleAllocated()then _wapi.EnableWindow(FHandle,v?true:false);
end
function SetVisible(v);override;
begin
inherited;
if HandleAllocated()then
begin
{
if v=SW_SHOWNOACTIVATE then
begin
_wapi.ShowWindow(FHandle,SW_SHOWNOACTIVATE);
end else
begin
_wapi.ShowWindow(FHandle,v?SW_SHOW:SW_HIDE);
end
if v=SW_SHOWNOACTIVATE then return ;
}
_wapi.ShowWindow(FHandle,v?SW_SHOW:SW_HIDE);
if(Parent is class(TWinControl))and parent.HandleAllocated()then
begin
if Align <> alNone then Parent.DoControlAlign();
end
{if V then
begin
DoControlAlign();
end }
end
end
function Hitcontrol(p);
begin
{**
@explan(说明) 命中控件 %%
**}
for i := ControlCount-1 downto 0 do
begin
it := Controls[i];
if it is class(TGraphicControl)then
begin
if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
begin
return it;
end
end
end
end
function MouseHover(O,e);override;
begin
inself := true;
initem := 0;
for i := ControlCount-1 downto 0 do
begin
it := FControls[i];
if(it is class(TGraphicControl))and it.visible then
begin
if inself and pointinrect(array(e.lolparamsigned,e.hilparamsigned),it.GetBoundsRect)and it.Enabled then
begin
initem := it;
inself := false;
end else
begin
it.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
end
end
end
if inself then return inherited;
else self.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
if initem then initem.Perform(messagecreater(nil,WM_MOUSEHOVER,0,0));
end
public //消息绑定函数
function WMMouseMove(o,e):LM_MOUSEMOVE;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMMouseMove(it,new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMLButtonUp(o,e):LM_LBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonUp(it,new TMMouse(LM_LBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMRButtonUp(o,e):LM_RBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonUp(it,new TMMouse(LM_RBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMMButtonUp(o,e):LM_MBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonUp(it,new TMMouse(LM_MBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMContextMenu(o,e):LM_CONTEXTMENU;override;
begin
ps := array(e.lolparamsigned,e.hilparamsigned);
_wapi.ScreenToClient(Handle,ps);
it := Hitcontrol(ps);
if it then
begin
ev := new TMMouse(e.msg,e.wparam,e.lparam);
r := it.Perform(ev);
e.Result := ev.Result;
e.skip := ev.skip;
end
return inherited;
end
function WMLButtonDown(o,e):LM_LBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDown(it,new TMMouse(LM_LBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMRButtonDown(o,e):LM_RBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonDown(it,new TMMouse(LM_RBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMMButtonDown(o,e):LM_MBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonDown(it,new TMMouse(LM_MBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;override;
begin
it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDBLCLK(it,new TMMouse(LM_LBUTTONDBLCLK,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
inherited;
end
public //设计器相关杂项
class function CaptionHeight();
begin
{**
@explan(说明) caption的高度 %%
@return(integer) 高度 %%
**}
return _wapi.GetSystemMetrics(SM_CYCAPTION);
end
function DesigningSelect(v);
begin
if ifnil(FDesignSelect)then FDesignSelect := false;
if ifnil(v)then return FDesignSelect;
if WsPopUp then return;
if not(csDesigning in ComponentState)then return;
nv := v?true:false;
if nv=FDesignSelect then return;
FDesignSelect := nv;
{$ifdef linux}
return InvalidateRect(nil,false);
{$endif}
rec := array(left,top,left+width,top+height);
rec[2:3]+= 1;
SetBoundsRect(rec);
rec[2:3]-= 1;
SetBoundsRect(rec);
end
private
FDesignSelect;
public //消息绑定函数
function ImageChanged();virtual;
begin
end
function WMNCPAINT(o,e):LM_NCPAINT;virtual;
begin
if (csDesigning in ComponentState) and FDesignSelect then
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;
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)
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;
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
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)));
_wapi.ReleaseDC(hWnd,hdc);
e.skip := true;
e.Result := 0;
end
end
procedure FontChanged(Sender:TObject);override;
begin
inherited;
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
if it.ParentFont then
begin
it.FontChanged(sender);
end
//InvalidateRect(nil,false);
//it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
end
end
function CMPARENTFONTCHANGED(o,e):CM_PARENTFONTCHANGED;virtual;
begin
//if ParentFont then
//begin
// _send_(WM_SETFONT,e.wparam,1);
//end
end
function WMGETMINMAXINFO(o,e):WM_GETMINMAXINFO;virtual;
begin
{**
@explan(说明) 最小窗口设置 %%
**}
k := 0;
if FMinWidth>0 then
begin
k .|= 1;
end
if FMinHeigt>0 then
begin
k .|= 2;
end
if FMaxHeight>0 then
begin
k .|= 4;
end
if FMaxWidth>0 then
begin
k .|= 8;
end
if k then
begin
d := new Ttagminmaxinfo(e.lparam);
ts := d.ptmintracksize;
case k of
1:ts[0]:= FMinWidth;
2:ts[1]:= FMinHeigt;
3:ts := array(FMinWidth,FMinHeigt);
end;
d.ptmintracksize := ts;
end
end
function CMFONTCHANGED(o,e):CM_FONTCHANGED;virtual;
begin
hd := e.wparam;
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0));
end
end
function WMSETFONT(o,e):WM_SETFONT;virtual;
begin
//defaulthandler(e);
//Perform(new tuieventbase(CM_FONTCHANGED,e.wparam,e.lparam,0));
end
function WMACTIVATE(o,e):WM_ACTIVATE;virtual;
begin
factivated := e.wparam;
CallMessgeFunction(OnActivate,o,e);
if e.skip then return ;
defaulthandler(e);
if factivated and ContainsControl(factivecontrol) then
begin
factivecontrol.SetFocus();
end
end
function GetClientRect();override;
begin
{**
@explan(说明)获得客户区大小 %%
@return(array of integer) 客户区矩形 %%
**}
ret := inherited;
if HandleAllocated()then
begin
if ifnumber(FClientWdith)and ifnumber(FClientHeight)then
begin
ret := array(0,0,FClientWdith,FClientHeight);
end else
_wapi.GetClientRect(self.Handle,ret);
end
//else ret := array(0,0,FClientWdith,FClientHeight);
return ret;
end
#!begin //消息
function DoCNALIGN(o,e);override;
begin
if(wstyle().& WS_POPUP)=WS_POPUP then exit;
inherited;
end
function DoWMCLOSE(o,e);virtual;
begin
EndModal();
end
function WMCLOSE(o,e):WM_CLOSE;virtual;
begin
CallMessgeFunction(OnClose,o,e);
DoWMCLOSE(o,e);
end
function WMCREATE(o,e):WM_CREATE;virtual;
begin
if e.lparam then
begin
co := new TCREATESTRUCT(e.lparam);
__wstyle := co.style;
__wexstyle := co.dwexstyle;
end
end
function WMSHOWWINDOW(o,e):WM_SHOWWINDOW;virtual;
begin
FVisible := e.wparam?true:false;
end
function WMSETCURSOR(o,e):WM_SETCURSOR;virtual;
begin
if e.lolparam=HTCLIENT then
begin
ne := new tuieventbase(CM_CURSORCHANGED,0,0);
Perform(ne);
if ne.skip then
begin
e.skip := true;
e.result := true;
end
end
end
function WMSTYLECHANGING(o,e):WM_STYLECHANGING;virtual;
begin
end
function WMNCDESTROY(o,e):WM_NCDESTROY;virtual;
begin
FHandle := nil;
factivated := false;
for i := 0 to FControls.count-1 do
begin
item := FControls[i];
if(item is class(TWinControl))and item.WsPopUp then
begin
item.DestroyHandle();
end
end
end
function WMSTYLECHANGED(o,e):WM_STYLECHANGED;virtual;
begin
end
function WMNCCALCSIZE(o,e):WM_NCCALCSIZE;virtual;
begin
if(csDesigning in ComponentState)and FDesignSelect then
begin
wd := 1;
hwd := wd;
rc := new TCRect(e.lparam);
rc.top += hwd;
rc.left += wd;
rc.bottom -= wd;
rc.right -= wd;
end
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
function WMMENURBUTTONUP(o,e):WM_MENURBUTTONUP;virtual;
begin
if PopupMenu and (PopupMenu is class(TcustomMenu))then PopupMenu.dispatch(e);
end
function WMMENUSELECT(o,e):WM_MENUSELECT;virtual;
begin
if PopupMenu and (PopupMenu is class(TcustomMenu))then PopupMenu.dispatch(e);
end
function WMINITMENUPOPUP(o,e):WM_INITMENUPOPUP;virtual;
begin
if PopupMenu and (PopupMenu is class(TcustomMenu))then PopupMenu.dispatch(e);
end
function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
begin
{**
@explan(说明) 背景绘制 %%
**}
if not HandleAllocated()then return;
mtic;
//if not(csCustomPaint in ControlState) and not(e.lparam) then return ;
dc := e.wparam;
if dc {and e.lparam}then
begin
if Enabled then
begin
cl := Color;
end else
begin
cl := cl_disabled_brush;
end
rect := array(0,0,0,0);
if e.lparam=2 then
begin
rect := PAINTSTRUCT().rcpaint();
end
_wapi.GetClientRect(self.Handle,rect);
if ifnumber(cl)then
begin
Canvas.Brush.Color := cl;
Canvas.Handle := dc;
Canvas.FillRect(rect);
end else
begin
cl := _wapi.GetStockObject(WHITE_BRUSH);
_wapi.FillRect(dc,rect,cl);
end
if(BKBitmap is class(tcustombitmap))and BKBitmap.HandleAllocated()then
begin
Canvas.Handle := dc;
//Canvas.StretchDraw(rect,BKBitmap);
Canvas.DrawBitmap(self.BKBitmap,rect);
end
e.skip := true;
e.Result := 1;
end
end
Function WMDRAWITEM(o,e):WM_DRAWITEM;virtual; //type_twinctrol
begin
{**
@ignore(忽略) %%
@explan(说明) 自绘制消息处理 %%
@param(o)(TWincontrol) 窗口控件 %%
@param(e)(TMDRAWITEM) 消息 %%
**}
e.canvas := canvas;
dc := e.hdc;
//dc := _wapi.GetDC(SELF.hANDLE);
//dcid := _wapi.SaveDC(dc);
canvas.handle := dc;
if(e.wparam=0)and(PopupMenu is class(TcustomMenu))then
begin
r := PopupMenu.dispatch(e);
if r then
begin
e.canvas := nil;
exit;
end
end
ctrl := getwndbyhwnd(e.hwndItem);
if ctrl then
begin
e.message := CN_DRAWITEM;
h := e.hwnd;
try
ctrl.Perform(const e);
except
end;
e.hwnd := h;
e.message := WM_DRAWITEM;
end
//if dcid then
// "\r\nrestor:",_wapi.RestoreDC(dc,-1);
e.canvas := nil;
// _wapi.ReleaseDC(Handle,Canvas.handle);
end
function WMMEASUREITEM(o,e):WM_MEASUREITEM;virtual;
begin
{**
@ignore(忽略) %%
@explan(说明) 测量消息处理 %%
@param(o)()控件本身 %%
@param(e)(TMMEASUREITEM)测量消息 %%
**}
if(e.wparam=0 and e.ctltype=ODT_MENU)and(PopupMenu is class(TcustomMenu))and PopupMenu.Dispatch(e)then exit;
for i := 0 to FControls.count-1 do
begin
it := FControls[i];
if it and it.getid=e.ctlid then
begin
h := e.hwnd;
e.message := CN_MEASUREITEM;
it.Perform(e);
e.message := WM_MEASUREITEM;
e.hwnd := h;
return;
end
end
end
function WMNOTIFY(o,e):WM_NOTIFY;virtual;
begin
{**
@explan(说明) 子控件通知父控件 %%
@param(e)(TMNOTIFY) 通知消息 %%
**}
hd := e.hwndfrom;
if hd then
begin
ctrl := getwndbyhwnd(hd);
if ctrl then
begin
nr := new tuieventbase(CN_NOTIFY,e.code,e.lparam);
ctrl.Perform(nr);
e.skip := nr.skip;
end
end
end
function WMCTLCOLORBTN(o,e):WM_CTLCOLORBTN;virtual;
begin
hd := e.lparam;
if hd then
begin
ctrl := getwndbyhwnd(hd);
if ctrl then
begin
ce := new tuieventbase(CN_CTLCOLORBTN,e.wparam,e.lparam,e.lparam);
ctrl.Canvas.handle := e.lparam;
ctrl.Perform(ce);
if ce.Result then
begin
e.result := ce.result;
e.skip := true;
end
end
end
end
function WMSYSCOMMAND(o,e):WM_SYSCOMMAND;virtual;
begin
//sysmenu.dispatch();
end
function WMCOMMAND(o,e):WM_COMMAND;virtual;
begin
if ftrackmenu and (ftrackmenu is class(TcustomMenu))and ftrackmenu.dispatch(e)then exit;
if PopupMenu and (popupmenu is class(TcustomMenu))and popupmenu.dispatch(e)then exit;
hd := e.lparam;
if hd then
begin
ctrl := getwndbyhwnd(hd);
if ctrl then
begin
wp := e.wparam;
ctrl.Perform(new tuieventbase(CN_COMMAND,wp,0));
end
end
end
function WMKEYDOWN(o,e):WM_KEYDOWN;virtual;
begin
CallMessgeFunction(FOnkeyDown,o,e);
if e.skip then return;
if HandleAllocated()and(e.wParam=VK_TAB)then
begin
cfoc := _wapi.GetFocus();
if Handle=cfoc then
begin
if TabStop then //发送给父控件
begin
if Parent then Parent._Send_(WM_KEYDOWN,VK_TAB,e.lparam,nil);
end
end else //遍历子控件 设置下一个focus
begin
cts := Controls;
Thec := false;
pc := 0;
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
begin
if ci.Handle=cfoc then //找到了当前
begin
Thec := true;
if pc and(ssShift in e.shiftstate)then
begin
pc.SetFocus();
break;
end
continue;
end
pc := ci;
if Thec then
begin
ci.SetFocus();
break;
end
end
end
end
end
return KeyDown(o,e);
end
function WMKEYUP(o,e):WM_KEYUP;virtual;
begin
CallMessgeFunction(FOnKeyUp,o,e);
keyup(o,e);
end
function WMSYSKEYUP(o,e):WM_SYSKEYUP;virtual;
begin
CallMessgeFunction(fonsyskeyup,o,e);
end
function WMSYSKEYDOWN(o,e):WM_SYSKEYDOWN;virtual;
begin
CallMessgeFunction(fonsyskeydown,o,e);
end
function WMSYSCHAR(o,e):WM_SYSCHAR;virtual;
begin
CallMessgeFunction(FOnSysKeyPress,o,e);
end
function WMCHAR(o,e):WM_CHAR;virtual;
begin
CallMessgeFunction(FOnKeyPress,o,e);
return keypress(o,e);
end
function WMSETFOCUS(o,e):WM_SETFOCUS;virtual;
begin
CallMessgeFunction(FonSetFocus,o,e);
dosetfocus(o,e);
end
function WMKILLFOCUS(o,e):WM_KILLFOCUS;virtual;
begin
CallMessgeFunction(FonKillFocus,o,e);
dokillfocus(o,e);
end
function WMPAINT(O,e):LM_PAINT;virtual;
begin
hd := e.hwnd;
if e.wparam then
begin
PaintHandler(e);
end else
if csCustomPaint in ControlState then
begin
ps := PaintStruct();
DC := _wapi.BeginPaint(hd,ps._getptr_);
if DC=0 then exit;
try
c := ClientRect;
memdc := dc;
{$ifdef gdipaint}
mdc := _wapi.GetDC(0);
if not mdc then exit;
mbit := _wapi.CreateCompatibleBitmap(mdc,c[2],c[3]);
if not mbit then exit;
memdc := _wapi.CreateCompatibleDC(0);
if not memdc then exit;
oldmp := _wapi.SelectObject(memdc,mbit);
_wapi.SaveDC(memdc);
_wapi.SetGraphicsMode(memdc,2);
{$else}
cr := ClientRect;
//rc := ps._getvalue_("rcpaint");
img := _wapi.cairo_image_surface_create(1,cr[2]-cr[0]+100,cr[3]-cr[1]+100);
memdc := _wapi.cairo_create(img);
rcpaint := ps.rcpaint;
_wapi.gtk_object_set_data(memdc,nil);
_wapi.cairo_reset_clip(memdc);
rng := _wapi.CreateRectRgn(rcpaint[0],rcpaint[1],rcpaint[2],rcpaint[3]);
_wapi.SelectClipRgn(memdc,rng);
{$endif}
e.wparam := memdc;
if Color then
begin
Dispatch(o,new tuieventbase(LM_ERASEBKGND,memdc,2));
end
Dispatch(o,e);
e.wparam := 0;
rc := ps.rcpaint;
{$ifdef gdipaint}
_wapi.RestoreDC(memdc,-1);
_wapi.BitBlt(dc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1],memdc,rc[0],rc[1],SRCCOPY); //_wapi.BitBlt(dc,c[0],c[1],c[2],c[3],memdc,0,0,SRCCOPY);
{$else}
_wapi.SelectClipRgn(memdc,0);
_wapi.cairo_set_source_surface(dc, img, 0, 0);
_wapi.cairo_rectangle(dc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1]);
_wapi.cairo_clip(dc);
_wapi.cairo_paint(dc);
_wapi.cairo_surface_destroy(img);
_wapi.cairo_destroy(memdc);
{$endif}
finally
_wapi.EndPaint(hd,ps._getptr_);
{$ifdef gdipaint}
_wapi.ReleaseDC(0,mdc);
_wapi.SelectObject(memdc,oldmp);
_wapi.DeleteDC(memdc);
_wapi.DeleteObject(mbit);
{$else}
{$endif}
end
end else
begin
{$ifdef gdipaint3}
ctls := Controls;
if not ctls then return; // e.skip := false;
if ctls.Count<1 then return; // e.skip := false ;
flag := true;
for i := 0 to ctls.Count-1 do
begin
ci := ctls[i];
if ci is class(TGraphicControl)then
begin
flag := false;
break;
end
end
if flag then
begin
return;
end
rec := zeros(4);
_wapi.GetUpdateRect(hd,rec,false);
defaulthandler(e);
dc := _wapi.GetDC(hd);
if not dc then
begin
return e.skip := true;
end
e.wparam := dc;
try
pts := PaintStruct();
pts._setvalue_("rcpaint",rec);
pts._setvalue_("hdc",dc);
//Perform(e);
Dispatch(o,e);
finally
_wapi.ReleaseDC(hd,dc);
e.wparam := 0;
e.skip := true;
end
{$endif}
end
e.skip := true;
e.result := true;
end
#!end
function KeyUp(o,e);virtual;
begin
{**
@explan(说明) key 松开 %%
@param(o)(TWinControl) 控件自身 %%
@Param(e)(TMKEY) 消息对象 %%
**}
end
function KeyDown(o,e);virtual;
begin
{**
@explan(说明) key 按下 %%
@param(o)(TWinControl) 控件自身 %%
@Param(e)(TMKEY) 消息对象 %%
**}
end
function keypress(o,e);virtual;
begin
{**
@explan(说明) char 消息处理 %%
@param(o)(TWinControl) 控件自身 %%
@Param(e)(TMKEY) 消息对象 %%
**}
end
function dosetfocus(o,e);virtual;
begin
{**
@explan(说明) 控件获得焦点 %%
@param(o)(TWinControl) 控件自身 %%
@Param(e)(tuieventbase) 消息对象 %%
**}
end
function dokillfocus(o,e);virtual;
begin
{**
@explan(说明) 控件失去焦点 %%
@param(o)(TWinControl) 控件自身 %%
@Param(e)(tuieventbase) 消息对象 %%
**}
end
protected //样式相关
function SetColor(v);override;
begin
oc := color;
if oc <> v and ifnumber(v)then
begin
inherited;
if HandleAllocated()then invalidaterect(nil,false);
end
end
function SetBitmap(v);override;
begin
if v <> BKBitmap then
begin
inherited;
if HandleAllocated()then invalidaterect(nil,false);
end
end
function Refresh();
begin
if HandleAllocated()then
begin
_wapi.SetWindowPos(self.Handle,0,0,0,0,0,SWP_DEFERERASE .| SWP_NOMOVE .| SWP_NOSIZE .| SWP_NOZORDER .| SWP_NOSENDCHANGING .| SWP_NOACTIVATE .| SWP_DRAWFRAME);
end
end
procedure PaintControls(DC:HDC;First:TControl); //type_twinctrol
begin
end
procedure PaintHandler(var TheMessage:TLMPaint); //type_twinctrol
begin
hdc := TheMessage.wparam;
PaintWindow(TheMessage.wparam);
//c := ClientRect;
c := array(0,0); //设置基准点,为00 20201112 修改
rcpaint := PaintStruct().rcpaint;
if sum(rcpaint)<4 then exit;
//rgC := _wapi.CreateRectRgn(0,0,10,10);
//rga := _wapi.CreateRectRgn(rcpaint[0],rcpaint[1],rcpaint[2],rcpaint[3]);
try
for i := 0 to ControlCount-1 do
begin
it := FControls[i];
if it is class(TGraphicControl)then
begin
if not(it.Visible)then continue;
itbounds := it.GetBoundsRect();
if not(intersectrect(itbounds,rcpaint,outrect))then
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); //裁剪区域
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);
it.Perform(ne);
_wapi.SetViewportOrgEx(TheMessage.wparam,c[0],c[1],nil); //恢复基准点
finally
//_wapi.SelectClipRgn(TheMessage.wparam,bkrg); //恢复区域
_wapi.DeleteObject(rgb); //销毁区域
end;
end
end
finally
//_wapi.DeleteObject(rga);
//_wapi.DeleteObject(rgc);
end;
end
procedure PaintWindow(DC:HDC);virtual;
begin
end
function SetTempCursor(Value);override;
begin
if(Value is class(tcustomcursor))and Value.HandleAllocated()and HandleAllocated()and Enabled and Visible then
begin
return Value.Show();
end
end
//public
function wstyle(v);
begin
{
@explan(说明)设置或者获取样式 %%
@param(v)(integer)为空获取样式,为整数 设置样式%%
@return(integer)当前样式
}
if v and ifnumber(v)then
begin
if(v <> __wstyle)and HandleAllocated()then _wapi.SetWindowLongPtrA(FHandle,GWL_STYLE,v);
end else
return __wstyle;
end
function wexstyle(v);
begin
{
@explan(说明)设置或者获取扩展样式 %%
@param(v)(integer)为空获取样式,为整数 设置样式%%
@return(integer)当前扩展样式
}
if v and ifnumber(v)then
begin
if(v <> __wexstyle)and HandleAllocated()then _wapi.SetWindowLongPtrA(FHandle,GWL_EXSTYLE,v);
end else
return __wexstyle;
end
function minuswstyle(v);
begin
{
@explan(说明)剔除样式 %%
@param(v)(integer) 剔除的样式 %%
}
if ifnumber(v)then
begin
s := wstyle();
ns := bitcombination(s,v,2);
if ns <> s then
begin
wstyle(ns);
end
end
end
function appendwstyle(v);
begin
{
@explan(说明)在原有样式中追加 样式%%
@param(v)(integer) 追加的样式 %%
}
if ifnumber(v)then
begin
s := wstyle();
ns := bitcombination(s,v,0);
if ns <> s then
begin
wstyle(ns);
end
end
end
function minuswexstyle(v);
begin
{
@explan(说明)剔除扩展样式 %%
@param(v)(integer) 剔除的样式 %%
}
if ifnumber(v)then
begin
s := wexstyle();
ns := bitcombination(s,v,2);
if ns <> s then
begin
wexstyle(ns);
end
end
end
function appendminuswstyple(ap,mi);
begin
{
@explan(说明)添加and剔除样式 %%
@param(ap)(integer) 添加的样式 %%
@param(mi)(integer) 剔除的样式 %%
}
if ifnumber(ap)or ifnumber(mi)then
begin
s := wstyle();
ns := s;
if ifnumber(ap)then ns := bitcombination(ns,ap,0);
if ifnumber(mi)then ns := bitcombination(ns,mi,2);
if ns <> s then
begin
wstyle(ns);
end
end
end
function appendminuswexstyple(ap,mi);
begin
{
@explan(说明)添加and剔除样式 %%
@param(ap)(integer) 添加的样式 %%
@param(mi)(integer) 剔除的样式 %%
}
if ifnumber(ap)or ifnumber(mi)then
begin
s := wexstyle();
ns := s;
if ifnumber(ap)then ns := bitcombination(ns,ap,0);
if ifnumber(mi)then ns := bitcombination(ns,mi,2);
if ns <> s then
begin
wexstyle(ns);
end
end
end
function appendwexstyle(v);
begin
{
@explan(说明)在原有扩展样式中追加 样式%%
@param(v)(integer) 追加的样式 %%
}
if ifnumber(v)then
begin
s := wexstyle();
ns := bitcombination(s,v,0);
if ns <> s then
begin
wexstyle(ns);
end
end
end
public //常用接口
function MonitorHandle();
begin
if HandleAllocated()then
begin
return _wapi.MonitorFromWindow(self.Handle,MONITOR_DEFAULTTONEAREST);
end
return 0;
end
function clienttowindow(x,y);
begin
{**
@explan(说明) 客户区坐标到窗口坐标的转换%%
**}
if WsPopUp and HandleAllocated()then
begin
xy := clienttoscreen(0,0);
rect := zeros(4);
_wapi.GetWindowRect(self.Handle,rect);
nxy := xy-rect[0:1];
r := array(x,y)+nxy;
return r;
end
return array(x,y);
end
function ClientToScreen(x,y);override;
begin
ps := array(x,y);
if HandleAllocated()then
begin
_wapi.ClientToScreen(self.Handle,ps);
end
return ps;
end
function ScreenToClient(x,y);override;
begin
ps := array(x,y);
if HandleAllocated()then
begin
_wapi.ScreenToClient(self.Handle,ps);
end
return ps;
end
function show(sw);
begin
{**
@explan(说明) 显示窗口 %%
@param(sw)(nil) 空 %%
**}
if ifnil(sw)then sw := SW_SHOW;
if not(sw >= 0)then return;
h := self.Handle;
if SW=SW_SHOW then return Visible := true;
if SW=SW_HIDE then return Visible := false;
//Visible := sw;
_wapi.ShowWindow(h,sw);
class(TControl).Visible := true;
end
function showmodal();virtual;
begin
return DoModal();
end
function EndModal(endc);virtual;
begin
{**
@explan(说明)关闭模态窗口 %%
@param(endc)(any) 为非nil 将作为EndModalCode %%
**}
if not ifnil(endc)then EndModalCode := endc;
{$ifdef gtkpaint}
if FModaling then
begin
if HandleAllocated()then _wapi.gtk_window_endmodal(self(true));
FModaling := false;
global G_O_TSWIN32API_;
if G_O_TSWIN32API_ then G_O_TSWIN32API_.PostQuitMessage(0);
end
return EndModalCode;
{$endif}
if not FModaling then return EndModalCode;
FModaling := FALSE;
if not HandleAllocated()then return EndModalCode;
_wapi.PostMessageA(0,0,0,0);
if Parent and Parent.HandleAllocated()then
begin
hParentWndt := parent.Handle;
hParentWnd := hParentWndt;
while(hParentWnd) do
begin
hParentWndt := _wapi.GetParent(hParentWnd);
if not hParentWndt then
begin
_wapi.BringWindowToTop(hParentWnd);
end
hParentWnd := hParentWndt;
end
end
return EndModalCode;
end
function UpdateWindow();
begin
{**
@explan(说明) 刷新窗口客户区 %%
@return(integer) 非0 成功 %%
**}
if HandleAllocated()then return _wapi.UpdateWindow(self.Handle);
end
function SetFocus();virtual;
begin
if HandleAllocated()then
begin
r := _wapi.SetFocus(self.Handle);
return r;
end
end
function setactive(); virtual;
begin
if not(factivated) and WsPopUp and HandleAllocated() then
begin
_wapi.SetActiveWindow(self.Handle);
end
end
function DescendantHwnd(hwnd);
begin
{
@explan(说明)判断窗口句柄是否为当前窗口句柄的子窗口 %%
}
if not _wapi.IsWindow(hwnd)then return 0;
if not HandleAllocated()then return 0;
shd := self.Handle;
wnd := hwnd;
while wnd do
begin
if wnd=shd then return true;
nwnd := _wapi.GetParent(wnd);
wnd := nwnd;
end
return false;
end
function MoveControlOrder(Acomponent,n);
begin
{**
@explan(说明) 移动控件的层 %%
@param(Acomponent)(tcontrol) 控件 %%
@param(n)(integer) 次序 %%
**}
dqid := FControls.IndexOf(Acomponent);
odp := FControls[n];
if n <> dqid and n >= 0 then
begin
FControls.setorder(dqid,n);
end
if odp is class(TWincontrol)and Acomponent is class(TWincontrol)and(Acomponent.HandleAllocated())and(odp.HandleAllocated())then
begin
_wapi.SetWindowPos(Acomponent.Handle,odp.Handle,0,0,0,0,SWP_NOMOVE .| SWP_NOSIZE);
end
if HandleAllocated()and(Acomponent.Align <> alNone)then
begin
DoControlAlign();
end
end
function BeginUpDate();
begin
FUpDateCount++;
end
function IsUpDating();
begin
return FUpDateCount;
end
function EndUpDate();
begin
if FUpDateCount>0 then
begin
FUpDateCount--;
DoEndUpDate();
end
end
function DoEndUpDate();virtual;
begin
if FUpDateCount=0 then
begin
if FPaintRects then
begin
if HandleAllocated()then
begin
ValidFlag := true;
for i,v in FPaintRects do
begin
if ifnil(v)then
begin
_wapi.InvalidateRect2(FHandle,nil,0);
ValidFlag := false;
break;
end
end
if ValidFlag then
begin
{$ifdef linux}
nrec := FPaintRects[0];
for i,v in FPaintRects do
begin
nrec := array(
min(nrec[0],v[0]),
min(nrec[1],v[1]),
max(nrec[2],v[2]),
max(nrec[3],v[3]),
);
end
_wapi.InvalidateRect(FHandle,nrec,f);
{$else}
for i,v in FPaintRects do
begin
_wapi.InvalidateRect(FHandle,v,f);
end
{$endif}
end
end
FPaintRects := array();
end
end
end
function InvalidateRect(rec,f);virtual;
begin
{**
@explan(说明)设置窗口区域无效 %%
@param(rec)(array) 无效区域,nil表示窗口整体无效,array(左上右下) %%
@param(f)(bool) 是否重画 %%
**}
if HandleAllocated()then
begin
if IsUpDating()then
begin
if not ifarray(FPaintRects)then FPaintRects := array();
FPaintRects[length(FPaintRects)]:= rec;
return;
end
if not(ifarray(rec)and rec)then r := _wapi.InvalidateRect2(FHandle,nil,f);
else r := _wapi.InvalidateRect(FHandle,rec,f);
return r;
end
end
function ContainsControl(Control_:TControl):bool;//包含控件
begin
Control := Control_;
while(Control is class(TWinControl)) and(Control <> Self) do Control := Control.Parent;
return Control=Self;
end
function create(owner);override; //type_twinctrol
begin
inherited;
AfterConstruction();
if foncreated then
begin
e := new tuieventbase(0,0,0,0);
e.sender := (self(true));
CallMessgeFunction(foncreated,self(true),e);
end
end
function AfterConstruction();virtual;
begin
FUpDateCount := 0;
FTabStop := false;
FBorderStyle := bsNone;
//FTRACKMOUSEEVENT := NEW TTRACKMOUSEEVENT();
FWsPopUp := false;
FWsSysMenu := false;
FWsCapton := false;
WSSizebox := FALSE;
__wstyle := 0; //窗口样式
__wexstyle := 0; //窗口扩展样式
FWsDlgModalFrame := false;
//FTtageDrawItem := new TtageDrawItem(); //移除了
FWMNCHITTEST := new TWMNCHITTEST();
FMinWidth := 1; //添加最小限制
FMinHeigt := 1;
end
function destroy();override; //type_twinctrol
begin
inherited;
end
function Recycling();override;
begin
DestroyHandle();
//FTtageDrawItem := nil;
FOnClose := nil;
FOnDesinedsel := nil;
FOnDesigDBLClick := nil;
FOnDesinedRclick := nil;
FOnDesignBeginMove := nil;
FOnDesignEndMove := nil;
FOnActivate := nil;
FOnKeyDown := nil;
FOnKeyPress := nil;
FOnKeyUp := nil;
ImageList := nil;
FonSetFocus := nil;
FonKillFocus := nil;
factivecontrol := nil;
inherited;
end
function RecreateWnd();virtual;
begin
if csDestroying in ComponentState then exit;
if HandleAllocated()then
begin
DestroyHandle();
HandleNeeded();
end
end
function CreateWnd();virtual; //type_twinctrol
begin
{**
@explan(说明)构建窗口句柄 %%
**}
//if not(Parent and Parent.HandleAllocated or (self(true) is class(tapplicationwindow))) then exit;
if not(parent) and not(csDesigning in ComponentState) and not(WsPopUp and (WsCaption or FWsSysMenu or FWsSizeBox)) then return ;
CreateParams(p);
//_wapi.GetSystemMetrics(SM_CXSCREEN) DIV 2;
//此处处理构造句柄
id := 0;
if p.style .& WS_CHILD then id := getid();
tcc := p.Caption;
stl := p.style;
x := p.x;
y := p.y;
sx := p.width;
sy := p.height;
selfid := integer(self(true));//int64
saveobj := new TGlobalValues(selfid,self(true));
createwndclass(p);
FDefWndproc := p.subclasswndproc;
tcn := P.WinClassName;
f := _wapi.CreateWindowExA(p.ExStyle,tcn,tcc,stl,x,y,sx,sy,p.WndParent,id,p.happ,selfid);
InitializeWnd();
if HandleAllocated()then
begin
ControlCreateWnd();
//处理初始化active的问题
if factivated and factivecontrol and ContainsControl(factivecontrol) then factivecontrol.SetFocus();
end
end
function TrackPopupMenu(mu,x,y); //弹出菜单
begin
ftrackmenu := mu;
if not(ifnumber(x) and ifnumber(y) ) then return 0;
if not(ftrackmenu and (ftrackmenu is class(TcustomMenu))) then return 0;
if HandleAllocated() then
begin
xy := ClientToScreen(x,y);
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
_wapi.TrackPopupMenu(ftrackmenu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
end
end
function Notification(ac,op);override;
begin
if op=opRecycling then
begin
if ac = factivecontrol then factivecontrol := nil;
if ac = ftrackmenu then ftrackmenu := nil;
end
inherited;
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
ctls := controls;
rcs := array();
sel := -1;
selr := 0;
len := ctls.count-1 ;
ct := 0;
for i:= 0 to len do
begin
vi := ctls[i];
if vi is class(TWinControl) then
begin
if vi.WsPopUp then continue;
if not(vi.Visible) then continue;
rcs[i] := vi.BoundsRect;
if vi.DesigningSelect() then
begin
sel := i;
selr := rcs[i];
end
ct++;
end
end
if (sel >=0) and (ct>1) then
begin
pc := cv.pen.color;
pct := cv.pen.style;
pcw := cv.pen.width;
cv.pen.Style := PS_DOT;
cv.pen.color := 0x3f3f3f;
for i := 0 to len do
begin
if i=sel then continue;
rc := rcs[i];
if not rc then continue;
if rc[0] = selr[0] then
begin
cv.moveto(array(rc[0],min(rc[1],selr[1])));
cv.LineTo(array(rc[0],max(rc[1],selr[1])));
end
if rc[1]=selr[1] then
begin
cv.moveto(array(min(rc[0],selr[0]),rc[1]));
cv.LineTo(array(max(rc[0],selr[0]),rc[1]));
end
if rc[2] = selr[2] then
begin
cv.moveto(array(rc[2],min(rc[1],selr[1])));
cv.LineTo(array(rc[2],max(rc[1],selr[1])));
end
if rc[3] = selr[3] then
begin
cv.moveto(array(min(rc[0],selr[0]),rc[3]));
cv.LineTo(array(max(rc[0],selr[0]),rc[3]));
end
end
cv.pen.color := pc;
cv.pen.style := pct;
cv.pen.width := pcw;
end
end
end
function ControlCreateWnd();
begin
for i := 0 to FControls.count-1 do
begin
item := FControls[i];
if(item is class(TWinControl))then
begin
item.HandleNeeded();
end
end
end
public
function HandleAllocated(); //type_twinctrol
begin
{**
@explan(说明)构建窗口句柄是否构造 %%
@param(bool)
**}
//return ifnumber(FHandle) and _wapi.IsWindow(FHandle);
return ifnumber(FHandle)and(FHandle <> 0);
end;
function DestroyHandle();virtual;
begin
{**
@explan(说明)析构窗口句柄 %%
**}
EndModal();
factivated := false;
if HandleAllocated()then
begin
{FTRACKMOUSEEVENT.hwndtrack := handle;
if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.dwflags := TME_CANCEL .| TME_HOVER .| TME_LEAVE;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
bv := FVisible;
_wapi.DestroyWindow(self.Handle);
FVisible := bv;
end
FHandle := 0;
end
procedure HandleNeeded();virtual; //type_twinctrol
begin
{**
@explan(说明)构建窗口句柄,以及子控件句柄 %%
@return(pointer) 窗口句柄
**}
{if (not HandleAllocated()) then
begin
if self.Parent = Self then
begin
end
else begin
if (Parent is class(TWinControl)) then
begin
Parent.HandleNeeded();
if HandleAllocated() then exit;
end;
end;
CreateHandle();
end; }
if(not HandleAllocated())and(not(csDestroying in ComponentState))then
begin
if self.Parent=Self then
begin
end else
begin
if {(Parent <> nil)}(Parent is class(TWinControl))then
begin
Parent.HandleNeeded();
if HandleAllocated()then exit;
end;
end;
CreateHandle();
end;
end
function SetParent(NewParent);override; //type_twinctrol
begin
ih := HandleAllocated();
if(NewParent=parent)and(NewParent is class(TWinControl))then //避免wrapcontrol句柄发生改变的问题
begin
if ih and NewParent.HandleAllocated()then
begin
if _wapi.GetParent(self.Handle)=NewParent.Handle then return;
end
end
if NewParent is class(TWinControl)then
begin
//if not CheckNewParent(NewParent) then return ;
//都有句柄
callparent := false;
callalocate := false;
ph := NewParent.HandleAllocated();
if ih and ph then
begin
if WsPopUp then
begin
DestroyHandle();
callalocate := true;
end else
if _wapi.SetParent(FHandle,NewParent.handle)then callparent := true;
end else
if ih and not(ph)then
begin
DestroyHandle();
callparent := true;
end else
if not(ih)and ph then
begin
callparent := true;
callalocate := true;
end else
begin
callparent := true;
end
if callparent then
begin
inherited SetParent(NewParent);//class(tcontrol).SetParent(NewParent);
if Align <> alNone then
begin
NewParent.DoControlAlign();
end
end
if callalocate then HandleNeeded();
end else
begin
if ih then DestroyHandle();
inherited SetParent(NewParent);
end
end
procedure SetBounds(ALeft,ATop,AWidth,AHeight:integer);override; //type_twinctrol
begin
{**
@explan(说明)设置窗口矩形区域 %%
**}
//设置bonds
OldBounds := BoundsRect;
OldBounds := array(OldBounds[0],OldBounds[1],OldBounds[2]-OldBounds[0],OldBounds[3]-OldBounds[1]);
newbounds := array(ALeft,ATop,AWidth,AHeight);
if not(CompareRect(OldBounds,newbounds))then
begin
inherited;
//class(tcontrol).SetBounds(ALeft, ATop, AWidth, AHeight);
end
end
private //绘制相关成员
FPaintRects;
FUpDateCount;
public
function gethitstyle(x,y);
begin
return FWMNCHITTEST.hitstyle2(self(true),x,y);
end
Procedure SetDesigning(Value,SetChildren);virtual; //设置设计状态
begin
inherited;
end;
public //消息分发
function MainWndProc(hwnd,message,wparam,lparam);virtual; //type_twinctrol
begin
{**
@explan(说明)窗口主循环 %%
**}
//if message=0x85 and not( WsCaption or border or WsDlgModalFrame) then return ;
e := messagecreater(hwnd,message,wparam,lparam);
e.sender := self(true);
if message = WM_SYSKEYDOWN or message = WM_KEYDOWN then //快捷键实现
begin
WndProc(const e);
if e.skip then return 1;
////////////解析热键/////////////////////
ec := e.CharCode;
sa := array();
if ec>=65 and ec<=90 then
begin
sa["w"] := chr(ec);
end
if ec>=0x70 and ec<=0x7b then
begin
sa["f"] := "F"+inttostr(ec-0x6F);
end
st := e.shiftstate;
if ssCtrl in st then sa["c"] := 1;
if ssAlt in st then sa["a"] := 1;
if ssShift in st then sa["s"] := 1;
if sa["w"] and (sa["c"] or sa["a"] or sa["s"]) then
begin
st := sa;
end else
if sa["f"] then
begin
st := sa;
end else
st := array();
if st then
begin
st := formatshortcut(st);
if st then
begin
if dispatchctlshortcut(self(true),st)= "havedoshortcut" then return 1; //执行本控件
if dispatchshortcut(class(tUIglobalData).uigetdata("tuiapplication"),st) = "havedoshortcut" then
begin
return 1;
end
end
end
//热键处理完成
return defaulthandler(e);
end
if message=WM_NCCREATE then
begin
FHandle := hwnd;
//echo "\r\nsethandle:",hwnd;
class(tUIglobalData).uigetdata("TGlobalComponentcache").registerhandle(hwnd,self(true));
end else
if message=WM_SIZE then
begin
x := e.lolparamsigned();
if x <> 0 then
begin
//dxsize := x-FClientWdith;
cc := 0;
if FClientWdith <> x then
begin
FClientWdith := x;
cc := true;
end
y := e.hilparamsigned();
//dysize := y-FClientHeight;
if FClientHeight <> y then
begin
FClientHeight := y;
//cc := true;
end
if true then
begin
DoControlAnchor();
DoControlAlign();
end
end
end else
{if message=WM_MOVE then
begin
x := e.lolparamsigned();
if FClientLeft <> x then FClientLeft := x;
y := e.hilparamsigned();
if FClientTop <> y then FClientTop := y;
end else}
//if message = WM_MOUSEMOVE then
if message=WM_NCHITTEST then //
begin
{if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.hwndtrack := hwnd;
FTRACKMOUSEEVENT.dwflags := TME_HOVER .| TME_LEAVE;
FTRACKMOUSEEVENT.dwhovertime := 600;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
end else
if message=WM_STYLECHANGED then
begin
if e.wparam=GWL_EXSTYLE then
begin
__wexstyle := e.stylenew;
end else
begin
__wstyle := e.stylenew;
end
end
(**else
if message = WM_NCCALCSIZE then
begin
if e.wparam=1 then
begin
dt := new tNCCALCSIZE_PARAMS(e.lparam)._getvalue_("rgrc");
if dt[0]=-32000 then
begin
//echo "\r\n隐藏到工具栏";
end
else if dt[4] = -32000 then
begin
//echo "\r\n从工具栏弹出";
end
else
begin
//rect1 := dt[0:3];
//rect2 := dt[4:7];
//rect3 := dt[8:];
{dx := dt[2]-dt[0]-(dt[6]-dt[4]);
dy := dt[3]-dt[1]-(dt[7]-dt[5]);
__clientsize := array(dt[10]-dt[8]+dx,dt[11]-dt[9]+dy);
x := __clientsize[0];
dxsize := x-FClientWdith;
if FClientWdith<> x then FClientWdith := x;
y := __clientsize[1];
dysize := y-FClientHeight;
if FClientHeight <> y then FClientHeight := y;
DoControlAnchor(array(dxsize,dysize));
DoControlAlign(array(0,0,x,y));}
//__oldclientsize := array(dt[10]-dt[8],dt[11]-dt[9]);
end
end
else
begin
//echo "\r\n++++calc:",caption,tostn(new tcrect(e.lparam)._getdata_);
end
//echo "\r\ncalcsize:",o.caption,"****",e.wparam;
//echo "\r\nleft:", new tcrect(e.lparam).left;
end
**)
WndProc(const e);
if not(e.skip)then
begin
ret := defaulthandler(e);
end else
begin
{$ifdef linuxgtk}
if WM_NCHITTEST=e.msg then return e.Result;
return true;
{$endif}
ret := e.Result;
end
return ret;
end
function DesigningSizer();virtual;
begin
{**
@explan(说明) 设计模式下面是否可以调整大小 %%
@return(bool)
**}
return true;
end
function DesigningClick();virtual;
begin
{**
@explan(说明) 设计模式下面是否可以响应原有的点击消息 %%
@return(bool)
**}
return false;
end
function DesigningMove();virtual;
begin
{**
@explan(说明) 设计模式下面是否可以移动 %%
@return(bool)
**}
return true;
end
function HitWindowborder(o,e,hit);virtual;
begin
{if not(WsSizeBox)and DesigningSizer()and(Align=alNone)then
begin
e.Result := hit;
e.skip := true;
end}
al := Align;
if not(WsSizeBox)and DesigningSizer() and(al<>alClient)then
begin
if (al = alNone) or
(hit= HTTOP and al =alBottom) or
(hit= HTBOTTOM and al =alTop) or
(hit= HTRIGHT and al =alLeft) or
(hit= HTLEFT and al =alRight)
then
begin
e.Result := hit;
e.skip := true;
if (csDesigning in ComponentState) then
begin
if al <> alNone then _send_(WM_USER,1644,1644,1);
end
end
end
end
private //设计器相关,消息
FClickTime;
FClickPos;
public //消息分发
procedure WndProc(e);override; //type_twinctrol
begin
//WM_NCHITTEST
if (csDesigning in ComponentState) then
begin
msg := e.msg;
if msg = WM_NCHITTEST then
begin
r := FWMNCHITTEST.hitstyle(self(true),e);
if r<>HTCLIENT then
begin
HitWindowborder(self(true),e,r);
end else
begin
return e.Result := Wnddefaulthandler(e);
end
end else
if msg= WM_LBUTTONDOWN then
begin
if not(WsCaption) and DesigningMove() and (Align=alNone) then
begin
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(OnDesignClick,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
CallMessgeFunction(FOnMouseUp,self(true),e);
end }
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(OnDesignDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(OnDesignRClick,self(true),e);
end else
if msg = WM_USER then
begin
if e.wparam=1644 and e.lparam=1644 then
begin
//Align=alNone;
al := Align;
if al in array(alLeft,alRight,alTop,alBottom) then
begin
bs := UnAlignBounds;
bs2 := BoundsRect;
if bs <> bs2 then
begin
Align := alNone;
Align := al;
end
end
end
end
end
inherited;
end;
procedure DoControlAlign({rect});override;
begin
{**
@explan(说明) 控件对齐 %%
**}
if not HandleAllocated()then exit;
if not ifarray(rect)then
begin
rect := ClientRect;
{$ifdef linuxgtk}
if Border or WSSizebox or WSDlgModalFrame then //处理gtk的情况
begin
rect[0]+=1;
rect[1]+=1;
rect[2]-=1;
rect[3]-=1;
end
{$endif}
end
e := new TMALIGN(CN_ALIGN,0,0,0);
E.left := rect[0];
e.top := rect[1];
e.width := rect[2];
e.height := rect[3];
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
if it is class(tcontrol)then
begin
//if it.Align=alNone then continue;
it.Dispatch(it,e);
//it.Perform(e);
end
end
end
procedure DoControlAnchor();override;
begin
{**
@explan(说明) 控件锚定调整 %%
**}
if not HandleAllocated()then exit;
e := new TMANCHOR(CN_ANCHOR,0,0,0);
c := ClientRect;
for i := 0 to ControlCount-1 do
begin
it := Controls[i];
if not it then continue;
if it.Align <> alNone then continue;
if not ifarray(it.Anchors)then continue;
if it is class(TWinControl)then
begin
if it.WsPopUp then continue;
end
e.prec := c;
it.Dispatch(it,e);
end
end
function Wnddefaulthandler(e); //type_twinctrol
begin
{**
@explan(说明)win32默认消息处理函数 %%
@param(e)(tuieventbase)
**}
r := _wapi.CallWindowProcA(FDefaultProc,e.Hwnd,e.msg,e.wparam,e.lparam);
e.skip := true;
return r;
end
function defaulthandler(e);override;
begin
{**
@explan(说明) 执行默认句柄 %%
@param(e)(tuieventbase)
**}
r := _wapi.CallWindowProcA(FDefWndproc,e.Hwnd,e.msg,e.wparam,e.lparam);
e.skip := true;
return r;
end
procedure BroadCast(e);
begin
{**
@explan(说明) 广播消息 %%
@param(e)(tuieventbase)
**}
for I := 0 to ControlCount-1 do
begin
Controls[I].WindowProc(e);
if e.skip then Exit;
if not ifnil(e.Result)then Exit;
end;
end;
procedure NotifyControls(Msg); //type_twinctrol
begin
ToAllMessage := new tuieventbase(msg,0,0,0);
Broadcast(ToAllMessage);
end
function _send_(msg,wparam,lparam,f,d);virtual; //type_twinctrol
begin
{**
@explan(说明) 发送消息给窗口 %%
@param(msg)(integer)消息号 %%
@param(wparam)(integer)wparam %%
@param(lparam)(integer)lparam %%
@param(param)(bool) true 采用post false 采用send %%
@return(pointer)
**}
if not(ifnumber(msg)and ifnumber(wparam)and ifnumber(lparam))then
begin
//messagebox("参数必须为数字,如果字符串参数,请用tslcstructre构造然后传入指针!","提示",1);
exit;
end
if HandleAllocated()then
begin
if f then
begin
return _wapi.PostMessageA(FHandle,msg,wparam,lparam {$ifdef linux},d {$endif});
end else
begin
return _wapi.SendMessageA(FHandle,msg,wparam,lparam);
end
end else
begin
e := messagecreater(nil,msg,wparam,lparam);
Perform(e);
return e.result;
end
end
function setwndhandle(h);
begin
{**
@ignore 忽略 %%
**}
DestroyHandle();
if _wapi.IsWindow(h)then
begin
ph := _wapi.SetWindowLongPtrA(h,_wapi.GWLP_WNDPROC,_wapi.getvclwindowprocA());
FDefWndproc := ph;
MainWndProc(h,WM_NCCREATE,0,0);
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;
//property MaxHeight:integer read FMaXHeight write SetMaxHeight;
property BorderStyle read GetBorderStyle write SetBorderStyle;
//property ParentWindow read FParentWindow write SetParentWindow;
property Handle read GetHandle write SetHandle;
property TabStop:bool read FTabStop write SetTabStop;
property ControlCount read GetControlCount;
property OnActivate:eventhandler read FOnActivate write FOnActivate;
property OnClose:eventhandler read FOnClose write FOnClose;
property OnKeyDown:eventhandler read FOnKeyDown write FOnKeyDown;
property OnsysKeyDown:eventhandler read FOnsysKeyDown write FOnsysKeyDown;
property OnKeyUp:eventhandler read FOnKeyUp write FOnKeyUp;
property OnsysKeyUp:eventhandler read FOnsysKeyUp write FOnsysKeyUp;
property OnKeyPress:eventhandler read FOnKeyPress write FOnKeyPress;
property OnSysKeyPress:eventhandler read FOnSysKeyPress write FOnSysKeyPress;
property OnDesignClick read FOnDesinedsel write FOnDesinedsel;
property OnDesignDBLClick read FOnDesigDBLClick write FOnDesigDBLClick;
property OnDesignRClick read FOnDesinedRclick write FOnDesinedRclick;
property WsPopUp:bool read GetWsPopUp write SetWsPopUp;
property WsDlgModalFrame:bool read FWsDlgModalFrame write SetWsDlgModalFrame;
property WsCaption:bool read GetWsCaption write SetWsCaption;
Property WSSizebox:bool read FWsSizeBox Write SetWSsizeBox;
property WSsysMenu:bool read FWsSysMenu write SetWsSysMenu;
property EndModalCode read FModalCode write FModalCode;
property ImageList:tcontrolimagelist read FImageList write SetImageList;
property onKillFocus:eventhandler read FonKillFocus write FonKillFocus;
property onSetFocus:eventhandler read FonSetFocus write fonSetFocus;
property oncreated:eventhandler read foncreated write foncreated;
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
private //模态相关
property Modaling read FModaling;
{**
@param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@param(Handle)(pointer) 窗口句柄 %%
@param(WsDlgModalFrame)(bool) dlg边框效果 %%
@param(ControlCount)(integer) 子控件数量 %%
@param(OnClose)(function[TWincontrol,tuieventbase]) 窗口关闭消息回调 %%
@param(OnKeyDown)(function[TWincontrol,TMKEY]) 按键按下回调 %%
@param(OnKeyUp)(function[TWincontrol,TMKEY]) 按键松开 %%
@param(OnKeyPress)(function[TWincontrol,TMKEY]) 字符消息 %%
**}
private //ShortCut
function dispatchshortcut(c,st); //快捷键分发
begin
if not st then return 0;
if c then
begin
ctb := class(tUIglobalData).uigetdata("G_T_TOOLBAR_");
if (c is class(TcustomMenu)) or (c is ctb) or (c is class(TCustomAction)) then
begin
if c.ExecuteCommand("doshortcut",st)="havedoshortcut" then return "havedoshortcut";
end
cc := c.Components ;
for i:= 0 to cc.count-1 do
begin
if dispatchshortcut(cc[i],st) then return "havedoshortcut";
end
end
return 0;
end
function dispatchctlshortcut(o,st); //控件分发热键
begin
if o is class(tcontrol) then
begin
if dispatchmenushortcut(o.Action,st) then return "havedoshortcut";
if dispatchmenushortcut(o.PopupMenu,st) then return "havedoshortcut";
end
w := class(tUIglobalData).uigetdata("G_T_TVCFORM_");//主窗口
if w and (o is w ) then
begin
if dispatchmenushortcut(o.MainMenu,st) then return "havedoshortcut";
end
w := class(tUIglobalData).uigetdata("G_T_TOOLBAR_");//工具条
if w and (o is w ) then
begin
if dispatchmenushortcut(o.MainMenu,st) then return "havedoshortcut";
end
end
function dispatchmenushortcut(mu,st); //菜单分发热键
begin
if mu is class(TcustomMenu) then
begin
if mu.ItemCount>0 then
begin
for i := 0 to mu.ItemCount-1 do
begin
if dispatchmenushortcut(mu.GetItemByIndex(i),st)="havedoshortcut" then return "havedoshortcut";
end
end else
begin
if mu.ExecuteCommand("doshortcut",st)="havedoshortcut" then return "havedoshortcut";
end
//if mu.ItemCount
end else
if mu is class(TCustomAction) then
begin
if mu.ExecuteCommand("doshortcut",st)="havedoshortcut" then return "havedoshortcut";
end
end
function setactivecontrol(ctl);virtual;
begin
if WsPopUp then
begin
if factivecontrol = ctl then return ;
if ctl is class(TWinControl) then
begin
factivecontrol := ctl;
if factivated then
begin
ctl.SetFocus();
end
end else
begin
factivecontrol := nil;
end
end else
begin
p := parent ;
if p then return p.ActiveControl := ctl;
end
end
function getactivecontrol();
begin
if WsPopUp then return factivecontrol;
factivecontrol := nil;
end
end
Reference in New Issue View Git Blame Copy Permalink