代码如下:

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
Message: TMessage;
begin
Message.Msg := Msg;
Message.WParam := WParam;
Message.LParam := LParam;
Message.Result := ;
if Self <> nil then WindowProc(Message);
Result := Message.Result;
end;

虽然函数本身有返回值,但是一般情况下,不使用函数的返回值,而是把返回值记录在消息结构体里面,举例:

procedure PerformEraseBackground(Control: TControl; DC: HDC);
var
LastOrigin: TPoint;
begin
GetWindowOrgEx(DC, LastOrigin);
SetWindowOrgEx(DC, LastOrigin.X + Control.Left, LastOrigin.Y + Control.Top, nil);
Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
end; procedure TControl.ReadState(Reader: TReader);
begin
Include(FControlState, csReadingState);
if Reader.Parent is TWinControl then Parent := TWinControl(Reader.Parent);
inherited ReadState(Reader);
Exclude(FControlState, csReadingState);
if Parent <> nil then
begin
Perform(CM_PARENTCOLORCHANGED, , );
Perform(CM_PARENTFONTCHANGED, , );
Perform(CM_PARENTSHOWHINTCHANGED, , );
Perform(CM_SYSFONTCHANGED, , );
Perform(CM_PARENTBIDIMODECHANGED, , );
end;
end; procedure TControl.Changed;
begin
Perform(CM_CHANGED, , Longint(Self));
end; procedure TControl.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
VisibleChanging;
FVisible := Value;
Perform(CM_VISIBLECHANGED, Ord(Value), );
RequestAlign;
end;
end; procedure TControl.SetEnabled(Value: Boolean);
begin
if FEnabled <> Value then
begin
FEnabled := Value;
Perform(CM_ENABLEDCHANGED, , );
end;
end; procedure TControl.SetTextBuf(Buffer: PChar);
begin
Perform(WM_SETTEXT, , Longint(Buffer));
Perform(CM_TEXTCHANGED, , );
end;

但是也有一些情况直接使用Perform函数的返回值,在Controls.pas单元里所有直接使用函数返回值的情况都摘录在这里了:

function TControl.GetTextLen: Integer;
begin
Result := Perform(WM_GETTEXTLENGTH, , );
end; function TControl.GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
begin
Result := Perform(WM_GETTEXT, BufSize, Longint(Buffer));
end; function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
var
Control: TControl;
P: TPoint;
begin
if GetCapture = Handle then
begin
if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
Control := CaptureControl
else
Control := nil;
end
else
Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
Result := False;
if Control <> nil then
begin
P.X := Message.XPos - Control.Left;
P.Y := Message.YPos - Control.Top;
Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
Result := True;
end;
end; procedure TWinControl.DefaultHandler(var Message);
begin
if FHandle <> then
begin
with TMessage(Message) do
begin
if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
begin
Result := Parent.Perform(Msg, WParam, LParam);
if Result <> 0 then Exit;
end;
case Msg of
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
begin
SetTextColor(WParam, ColorToRGB(FFont.Color));
SetBkColor(WParam, ColorToRGB(FBrush.Color));
Result := FBrush.Handle;
end;
else
if Msg = RM_GetObjectInstance then
Result := Integer(Self)
else
begin
if Msg <> WM_PAINT then
Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;
end;
if Msg = WM_SETTEXT then
SendDockNotification(Msg, WParam, LParam);
end;
end
else
inherited DefaultHandler(Message);
end; procedure TWinControl.CNKeyUp(var Message: TWMKeyUp);
begin
if not (csDesigning in ComponentState) then
with Message do
case CharCode of
VK_TAB, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN,
VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
Result := Perform(CM_WANTSPECIALKEY, CharCode, );
end;
end; procedure TWinControl.CNSysChar(var Message: TWMChar);
begin
if not (csDesigning in ComponentState) then
with Message do
if CharCode <> VK_SPACE then
Result := GetParentForm(Self).Perform(CM_DIALOGCHAR,
CharCode, KeyData);
end; procedure TWinControl.WMContextMenu(var Message: TWMContextMenu);
var
Ctrl: TControl;
begin
if Message.Result <> 0 then Exit;
Ctrl := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), False);
if Ctrl <> nil then
Message.Result := Ctrl.Perform(WM_CONTEXTMENU, 0, Integer(Message.Pos)); if Message.Result = 0 then
inherited;
end;

这还不算,还得看看那些记录在消息结构体里的返回值是被如何使用的:

procedure TControl.MouseWheelHandler(var Message: TMessage);
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if (Form <> nil) and (Form <> Self) then Form.MouseWheelHandler(TMessage(Message))
else with TMessage(Message) do
Result :=
Perform(CM_MOUSEWHEEL, WParam, LParam);
end; procedure TControl.DefaultHandler(var Message);
var
P: PChar;
begin
with TMessage(Message) do
case Msg of
WM_GETTEXT:
begin
if FText <> nil then P := FText else P := '';
Result := StrLen(StrLCopy(PChar(LParam), P, WParam - ));
end;
WM_GETTEXTLENGTH:
if FText = nil then Result := else Result := StrLen(FText);
WM_SETTEXT:
begin
P := StrNew(PChar(LParam));
StrDispose(FText);
FText := P;
SendDockNotification(Msg, WParam, LParam);
end;
end;
end; procedure TControl.WMMouseWheel(var Message: TWMMouseWheel);
begin
if not Mouse.WheelPresent then
begin
Mouse.FWheelPresent := True;
Mouse.SettingChanged(SPI_GETWHEELSCROLLLINES);
end;
TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
MouseWheelHandler(TMessage(Message));
if Message.Result = 0 then inherited; // 如果消息没有被处理,就要送到DefaultHandler里去
end; procedure TControl.CMMouseWheel(var Message: TCMMouseWheel);
begin
with Message do
begin
Result := ;
if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
Message.Result := 1

else if Parent <> nil then
with TMessage(Message) do
Result
:= Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
end;
end; procedure TWinControl.Broadcast(var Message);
var
I: Integer;
begin
for I := to ControlCount - do
begin
Controls[I].WindowProc(TMessage(Message));
if TMessage(Message).Result <> 0 then Exit; // 如果有一个子控件(图形和Win控件)处理过了,就退出广播
end;
end; procedure TWinControl.DefaultHandler(var Message);
begin
if FHandle <> then
begin
with TMessage(Message) do
begin
if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
begin
Result :=
Parent.Perform(Msg, WParam, LParam);
if Result <> then Exit; // 即使不退出,好像也没什么机会继续传递了
end;
case Msg of
WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
begin
SetTextColor(WParam, ColorToRGB(FFont.Color));
SetBkColor(WParam, ColorToRGB(FBrush.Color));
Result := FBrush.Handle;
end;
else
if Msg = RM_GetObjectInstance then
Result :=
Integer(Self)
else
begin
if Msg <> WM_PAINT then
Result :=
CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;
end;
if Msg = WM_SETTEXT then
SendDockNotification(Msg, WParam, LParam);
end;
end
else
inherited DefaultHandler(Message);
end; function DoControlMsg(ControlHandle: HWnd; var Message): Boolean;
var
Control: TWinControl;
begin
DoControlMsg := False;
Control := FindControl(ControlHandle);
if Control <> nil then
with TMessage(Message) do
begin
Result :=
Control.Perform(Msg + CN_BASE, WParam, LParam);
DoControlMsg := True; // 不多见的函数返回值写法
end;
end; procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
with ThemeServices do
if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
begin
{ Get the parent to draw its background into the control's background. }
DrawParentBackground(Handle, Message.DC, nil, False);
end
else
begin
{ Only erase background if we're not doublebuffering or painting to memory. }
if not FDoubleBuffered or
(TMessage(Message).wParam = TMessage(Message).lParam) then
FillRect(Message.DC, ClientRect, FBrush.Handle);
end; Message.Result := 1;
end;

结论:它的存在仅仅是为了方便复用消息的返回值,至少官方提供的Perform函数清清楚楚、明明白白,就只有这个意思。

当然Perform作为一个函数提供返回值,还有2个好处:1.在处理的过程中偷梁换柱 2.覆盖Perform函数都可以(虽然一般没有必要这么做),但这两点几乎不用考虑。普通程序员怎么可能会做这种修改VCL核心代码的事情,根本没必要。

终于懂了:TControl.Perform是有返回值的,且看VCL框架如何利用消息的返回值(全部例子都在这里)——它的存在仅仅是为了方便复用消息的返回值的更多相关文章

  1. 终于懂了:Delphi消息的Result域出现的原因——要代替回调函数的返回值!(MakeObjectInstance不会帮助处理(接收)消息回调函数的返回值)

    MakeObjectInstance应该不会帮助处理(接收)消息回调函数的返回值,可是有时候又确实需要这个返回值,这可怎么办呢?我是看到这段文字的时候,想到这个问题的: 当WM_PAINT不是由Inv ...

  2. System V 消息队列 - 复用消息

    消息队列中的消息结构可以由我们自由定义,具备较强的灵活性.通过消息结构可以共享一个队列,进行消息复用.通常定义一个类似如下的消息结构: #define MSGMAXDAT 1024 struct my ...

  3. 05 返回静态文件的多线程web框架

    05 返回静态文件的多线程web框架 服务器server端python程序(多线程版): import socket from threading import Thread,currentThrea ...

  4. 04 返回静态文件的函数web框架

    04 返回静态文件的函数web框架 服务器server端python程序(函数版): import socket server = socket.socket() server.bind((" ...

  5. 03 返回静态文件的高级web框架

    03 返回静态文件的高级web框架 服务器server端python程序(高级版): import socket server=socket.socket() server.bind(("1 ...

  6. 深刻:截获windows的消息并分析实例(DefWindowProc),以WM_NCHITTEST举例(Windows下每一个鼠标消息都是由 WM_NCHITTEST 消息产生的,这个消息的参数包含了鼠标位置的信息)

    1,回调函数工作机制 回调函数由操作系统自动调用,回调函数的返回值当然也是返回给操作系统了. 2,截获操作系统发出的消息,截获到后,将另外一个消息返回给操作系统,已达到欺骗操作系统的目的. 下面还是以 ...

  7. TGraphicControl(自绘就2步,直接自绘自己,不需要调用VCL框架提供的函数重绘所有子控件,也不需要自己来提供PaintWindow函数让管理框架来调用)与TControl关键属性方法速记(Repaint要求父控件执行详细代码来重绘自己,还是直接要求Invalidate无效后Update刷新父控件,就看透明不透明这个属性,因为计算显示的区域有所不同)

    TGraphicControl = class(TControl) private FCanvas: TCanvas; procedure WMPaint(var Message: TWMPaint) ...

  8. 深入解析Windows窗口创建和消息分发(三个核心问题:怎么将不同的窗口过程勾到一起,将不同的hwnd消息分发给对应的CWnd类去处理,CWnd如何简单有效的去处理消息,由浅入深,非常清楚) good

    笔记:争取不用看下面的内容,只看自己的笔记,就能记住这个流程,就算明白了: _tWinMain-->AfxWinMain,它调用四个函数: -->AfxWinInit用于做一些框架的初始化 ...

  9. WPF的消息机制(三)- WPF内部的5个窗口之处理激活和关闭的消息窗口以及系统资源通知窗口

    原文:WPF的消息机制(三)- WPF内部的5个窗口之处理激活和关闭的消息窗口以及系统资源通知窗口 版权声明:本文为博主原创文章,未经博主允许不得转载. https://blog.csdn.net/p ...

随机推荐

  1. mysql tcp 4层负载

    -bash-4.1# cat /etc/haproxy/haproxy.cfg global log 127.0.0.1 local3 maxconn 65535 chroot /usr/local/ ...

  2. Unity Interface Serialization-Expose Interface field In Inspector

    Unity has some quirks about their inspector, so as a preface they are listed here: If you add a [Ser ...

  3. Notepad++中如何设置自动换行以及行宽

    view-->word wrap; setting->preference-->vertical edge settings; Notepad++中如何设置自动换行以及行宽 http ...

  4. LWP::UserAgent - Web user agent class Web 用户agent 类:

    LWPUserAgent: LWP::UserAgent - Web user agent class Web 用户agent 类: 概述: require LWP::UserAgent; my $u ...

  5. Mina airQQ聊天 服务端篇(二)

    Mina聊天服务端实现思路:在用户登录的时候.连接服务端而且验证登录用户,假设成功,则将IoSession保存到map<账号,IoSession>中,而且通知该用户的好友上线,然 后再请求 ...

  6. Swift - 初始化方法返回nil表示初始化失败

    自Swift1.1开始,初始化init方法便有返回nil的能力.我们可以在init声明的时候在其后面加上一个 ? 或者 ! 来表示初始化失败时可能返回nil. 比如,给Int类添加一个将字符串初始化成 ...

  7. 转:python idle 清屏问题的解决

    http://www.cnblogs.com/maybego/p/3234055.html python idle 清屏问题的解决 在学习和使用python的过程中,少不了要与python idle打 ...

  8. twemproxy 简介

    twemproxy,也叫nutcraker.是twtter开源的一个redis和memcache代理服务器. redis作为一个高效的缓存服务器,非常具有应用价值.但是当使用比较多的时候,就希望可以通 ...

  9. jssdk微信图片上传功能

    /*wx.config({ debug: false, appId: data.appid, timestamp: data.timestamp, nonceStr: data.nonceStr, s ...

  10. openstack中Nova组件images的全部python API 汇总

    感谢朋友支持本博客.欢迎共同探讨交流,因为能力和时间有限,错误之处在所难免.欢迎指正! 假设转载,请保留作者信息. 博客地址:http://blog.csdn.net/qq_21398167 原博文地 ...