代码如下:

  1. function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
  2. var
  3. Message: TMessage;
  4. begin
  5. Message.Msg := Msg;
  6. Message.WParam := WParam;
  7. Message.LParam := LParam;
  8. Message.Result := ;
  9. if Self <> nil then WindowProc(Message);
  10. Result := Message.Result;
  11. end;

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

  1. procedure PerformEraseBackground(Control: TControl; DC: HDC);
  2. var
  3. LastOrigin: TPoint;
  4. begin
  5. GetWindowOrgEx(DC, LastOrigin);
  6. SetWindowOrgEx(DC, LastOrigin.X + Control.Left, LastOrigin.Y + Control.Top, nil);
  7. Control.Parent.Perform(WM_ERASEBKGND, Integer(DC), Integer(DC));
  8. SetWindowOrgEx(DC, LastOrigin.X, LastOrigin.Y, nil);
  9. end;
  10.  
  11. procedure TControl.ReadState(Reader: TReader);
  12. begin
  13. Include(FControlState, csReadingState);
  14. if Reader.Parent is TWinControl then Parent := TWinControl(Reader.Parent);
  15. inherited ReadState(Reader);
  16. Exclude(FControlState, csReadingState);
  17. if Parent <> nil then
  18. begin
  19. Perform(CM_PARENTCOLORCHANGED, , );
  20. Perform(CM_PARENTFONTCHANGED, , );
  21. Perform(CM_PARENTSHOWHINTCHANGED, , );
  22. Perform(CM_SYSFONTCHANGED, , );
  23. Perform(CM_PARENTBIDIMODECHANGED, , );
  24. end;
  25. end;
  26.  
  27. procedure TControl.Changed;
  28. begin
  29. Perform(CM_CHANGED, , Longint(Self));
  30. end;
  31.  
  32. procedure TControl.SetVisible(Value: Boolean);
  33. begin
  34. if FVisible <> Value then
  35. begin
  36. VisibleChanging;
  37. FVisible := Value;
  38. Perform(CM_VISIBLECHANGED, Ord(Value), );
  39. RequestAlign;
  40. end;
  41. end;
  42.  
  43. procedure TControl.SetEnabled(Value: Boolean);
  44. begin
  45. if FEnabled <> Value then
  46. begin
  47. FEnabled := Value;
  48. Perform(CM_ENABLEDCHANGED, , );
  49. end;
  50. end;
  51.  
  52. procedure TControl.SetTextBuf(Buffer: PChar);
  53. begin
  54. Perform(WM_SETTEXT, , Longint(Buffer));
  55. Perform(CM_TEXTCHANGED, , );
  56. end;

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

  1. function TControl.GetTextLen: Integer;
  2. begin
  3. Result := Perform(WM_GETTEXTLENGTH, , );
  4. end;
  5.  
  6. function TControl.GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  7. begin
  8. Result := Perform(WM_GETTEXT, BufSize, Longint(Buffer));
  9. end;
  10.  
  11. function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
  12. var
  13. Control: TControl;
  14. P: TPoint;
  15. begin
  16. if GetCapture = Handle then
  17. begin
  18. if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
  19. Control := CaptureControl
  20. else
  21. Control := nil;
  22. end
  23. else
  24. Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
  25. Result := False;
  26. if Control <> nil then
  27. begin
  28. P.X := Message.XPos - Control.Left;
  29. P.Y := Message.YPos - Control.Top;
  30. Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
  31. Result := True;
  32. end;
  33. end;
  34.  
  35. procedure TWinControl.DefaultHandler(var Message);
  36. begin
  37. if FHandle <> then
  38. begin
  39. with TMessage(Message) do
  40. begin
  41. if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
  42. begin
  43. Result := Parent.Perform(Msg, WParam, LParam);
  44. if Result <> 0 then Exit;
  45. end;
  46. case Msg of
  47. WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  48. Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
  49. CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  50. begin
  51. SetTextColor(WParam, ColorToRGB(FFont.Color));
  52. SetBkColor(WParam, ColorToRGB(FBrush.Color));
  53. Result := FBrush.Handle;
  54. end;
  55. else
  56. if Msg = RM_GetObjectInstance then
  57. Result := Integer(Self)
  58. else
  59. begin
  60. if Msg <> WM_PAINT then
  61. Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
  62. end;
  63. end;
  64. if Msg = WM_SETTEXT then
  65. SendDockNotification(Msg, WParam, LParam);
  66. end;
  67. end
  68. else
  69. inherited DefaultHandler(Message);
  70. end;
  71.  
  72. procedure TWinControl.CNKeyUp(var Message: TWMKeyUp);
  73. begin
  74. if not (csDesigning in ComponentState) then
  75. with Message do
  76. case CharCode of
  77. VK_TAB, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN,
  78. VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
  79. Result := Perform(CM_WANTSPECIALKEY, CharCode, );
  80. end;
  81. end;
  82.  
  83. procedure TWinControl.CNSysChar(var Message: TWMChar);
  84. begin
  85. if not (csDesigning in ComponentState) then
  86. with Message do
  87. if CharCode <> VK_SPACE then
  88. Result := GetParentForm(Self).Perform(CM_DIALOGCHAR,
  89. CharCode, KeyData);
  90. end;
  91.  
  92. procedure TWinControl.WMContextMenu(var Message: TWMContextMenu);
  93. var
  94. Ctrl: TControl;
  95. begin
  96. if Message.Result <> 0 then Exit;
  97. Ctrl := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), False);
  98. if Ctrl <> nil then
  99. Message.Result := Ctrl.Perform(WM_CONTEXTMENU, 0, Integer(Message.Pos));
  100. if Message.Result = 0 then
  101. inherited;
  102. end;

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

  1. procedure TControl.MouseWheelHandler(var Message: TMessage);
  2. var
  3. Form: TCustomForm;
  4. begin
  5. Form := GetParentForm(Self);
  6. if (Form <> nil) and (Form <> Self) then Form.MouseWheelHandler(TMessage(Message))
  7. else with TMessage(Message) do
  8. Result := Perform(CM_MOUSEWHEEL, WParam, LParam);
  9. end;
  10.  
  11. procedure TControl.DefaultHandler(var Message);
  12. var
  13. P: PChar;
  14. begin
  15. with TMessage(Message) do
  16. case Msg of
  17. WM_GETTEXT:
  18. begin
  19. if FText <> nil then P := FText else P := '';
  20. Result := StrLen(StrLCopy(PChar(LParam), P, WParam - ));
  21. end;
  22. WM_GETTEXTLENGTH:
  23. if FText = nil then Result := else Result := StrLen(FText);
  24. WM_SETTEXT:
  25. begin
  26. P := StrNew(PChar(LParam));
  27. StrDispose(FText);
  28. FText := P;
  29. SendDockNotification(Msg, WParam, LParam);
  30. end;
  31. end;
  32. end;
  33.  
  34. procedure TControl.WMMouseWheel(var Message: TWMMouseWheel);
  35. begin
  36. if not Mouse.WheelPresent then
  37. begin
  38. Mouse.FWheelPresent := True;
  39. Mouse.SettingChanged(SPI_GETWHEELSCROLLLINES);
  40. end;
  41. TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
  42. MouseWheelHandler(TMessage(Message));
  43. if Message.Result = 0 then inherited; // 如果消息没有被处理,就要送到DefaultHandler里去
  44. end;
  45.  
  46. procedure TControl.CMMouseWheel(var Message: TCMMouseWheel);
  47. begin
  48. with Message do
  49. begin
  50. Result := ;
  51. if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
  52. Message.Result := 1
  53. else if Parent <> nil then
  54. with TMessage(Message) do
  55. Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
  56. end;
  57. end;
  58.  
  59. procedure TWinControl.Broadcast(var Message);
  60. var
  61. I: Integer;
  62. begin
  63. for I := to ControlCount - do
  64. begin
  65. Controls[I].WindowProc(TMessage(Message));
  66. if TMessage(Message).Result <> 0 then Exit; // 如果有一个子控件(图形和Win控件)处理过了,就退出广播
  67. end;
  68. end;
  69.  
  70. procedure TWinControl.DefaultHandler(var Message);
  71. begin
  72. if FHandle <> then
  73. begin
  74. with TMessage(Message) do
  75. begin
  76. if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
  77. begin
  78. Result := Parent.Perform(Msg, WParam, LParam);
  79. if Result <> then Exit; // 即使不退出,好像也没什么机会继续传递了
  80. end;
  81. case Msg of
  82. WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  83. Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
  84. CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  85. begin
  86. SetTextColor(WParam, ColorToRGB(FFont.Color));
  87. SetBkColor(WParam, ColorToRGB(FBrush.Color));
  88. Result := FBrush.Handle;
  89. end;
  90. else
  91. if Msg = RM_GetObjectInstance then
  92. Result := Integer(Self)
  93. else
  94. begin
  95. if Msg <> WM_PAINT then
  96. Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
  97. end;
  98. end;
  99. if Msg = WM_SETTEXT then
  100. SendDockNotification(Msg, WParam, LParam);
  101. end;
  102. end
  103. else
  104. inherited DefaultHandler(Message);
  105. end;
  106.  
  107. function DoControlMsg(ControlHandle: HWnd; var Message): Boolean;
  108. var
  109. Control: TWinControl;
  110. begin
  111. DoControlMsg := False;
  112. Control := FindControl(ControlHandle);
  113. if Control <> nil then
  114. with TMessage(Message) do
  115. begin
  116. Result := Control.Perform(Msg + CN_BASE, WParam, LParam);
  117. DoControlMsg := True; // 不多见的函数返回值写法
  118. end;
  119. end;
  120.  
  121. procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  122. begin
  123. with ThemeServices do
  124. if ThemesEnabled and Assigned(Parent) and (csParentBackground in FControlStyle) then
  125. begin
  126. { Get the parent to draw its background into the control's background. }
  127. DrawParentBackground(Handle, Message.DC, nil, False);
  128. end
  129. else
  130. begin
  131. { Only erase background if we're not doublebuffering or painting to memory. }
  132. if not FDoubleBuffered or
  133. (TMessage(Message).wParam = TMessage(Message).lParam) then
  134. FillRect(Message.DC, ClientRect, FBrush.Handle);
  135. end;
  136.  
  137. Message.Result := 1;
  138. 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. [置顶] think in java interview-高级开发人员面试宝典(八)

    面经出了7套,收到许多读者的Email,有许多人说了,这些基础知识是不是为了后面进一步的”通向架构师的道路“做准备的? 对的,你们没有猜错,就是这样的,我一直在酝酿后面的”通向架构师的道路“如何开章. ...

  2. android开发之蓝牙配对连接的方法

    最近在做蓝牙开锁的小项目,手机去连接单片机总是出现问题,和手机的连接也不稳定,看了不少蓝牙方面的文档,做了个关于蓝牙连接的小结. 在做android蓝牙串口连接的时候一般会使用 ? 1 2 3 4 5 ...

  3. jQuery 3.0 的 Data

    jQuery 3.0 的 Data Snandy If you cannot hear the sound of the genuine in you, you will all of your li ...

  4. 基于visual Studio2013解决C语言竞赛题之1050矩阵反斜线求和

       题目 解决代码及点评 /************************************************************************/ /* 50 ...

  5. TCP协议中的计时器

    说明:  本文仅供学习交流.转载请标明出处,欢迎转载! 本文是下面文献相关内容的总结 [1] <TCP/IP具体解释 卷1:协议> [2] <TCP/IP协议族 第4版> [3 ...

  6. PYTHON学习第二天[脑图][2]

    控制流语句:if , for ,while , break , continue

  7. 细节!重点!易错点!--面试java基础篇(一)

    今天来给大家分享一下java的重点易错点部分,也是各位同学面试需要准备的,欢迎大家交流指正. 1.java中的main方法是静态方法,即方法中的代码是存储在静态存储区的. 2.任何静态代码块都会在ma ...

  8. URAL 1018 (金典树形DP)

    连接:1018. Binary Apple Tree Time limit: 1.0 second Memory limit: 64 MB Let's imagine how apple tree l ...

  9. 安装Oracle时可能碰到的常见问题-1

    安装Oracle可能有些人觉得是一件非常easy的事情,但事实上是在安装的过程中蕴含着丰富的知识点.尤其安装在Linux平台,可能会碰到这样或那样各种诡异的问题,透过问题看到本质,这才是从深处理解Or ...

  10. biz处理dao事务处理层

    前言 正文 1.创建一个事物管理对象,该对象将连接对象绑定到当前线程 2.dao层的代码演示样例 3.biz层处理数据库的事务 总结