TControl.Perform是有返回值的,且看VCL框架如何利用消息的返回值(全部例子都在这里)

代码如下:

function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
  Message: TMessage;
begin
  Message.Msg := Msg;
  Message.WParam := WParam;
  Message.LParam := LParam;
  Message.Result := 0;
  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, 0, 0);
    Perform(CM_PARENTFONTCHANGED, 0, 0);
    Perform(CM_PARENTSHOWHINTCHANGED, 0, 0);
    Perform(CM_SYSFONTCHANGED, 0, 0);
    Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  end;
end;

procedure TControl.Changed;
begin
  Perform(CM_CHANGED, 0, Longint(Self));
end;

procedure TControl.SetVisible(Value: Boolean);
begin
  if FVisible <> Value then
  begin
    VisibleChanging;
    FVisible := Value;
    Perform(CM_VISIBLECHANGED, Ord(Value), 0);
    RequestAlign;
  end;
end;

procedure TControl.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    Perform(CM_ENABLEDCHANGED, 0, 0);
  end;
end;

procedure TControl.SetTextBuf(Buffer: PChar);
begin
  Perform(WM_SETTEXT, 0, Longint(Buffer));
  Perform(CM_TEXTCHANGED, 0, 0);
end;

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

function TControl.GetTextLen: Integer;
begin
  Result := Perform(WM_GETTEXTLENGTH, 0, 0);
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 <> 0 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, 0);
      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 - 1));
        end;
      WM_GETTEXTLENGTH:
        if FText = nil then Result := 0 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;
end;

procedure TControl.CMMouseWheel(var Message: TCMMouseWheel);
begin
  with Message do
  begin
    Result := 0;
    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 := 0 to ControlCount - 1 do
  begin
    Controls[I].WindowProc(TMessage(Message));
    if TMessage(Message).Result <> 0 then Exit;
  end;
end;

procedure TWinControl.DefaultHandler(var Message);
begin
  if FHandle <> 0 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;

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;
时间: 2024-12-03 06:51:41

TControl.Perform是有返回值的,且看VCL框架如何利用消息的返回值(全部例子都在这里)的相关文章

接口自动化(Python)-利用正则表达式从返回的HTML文本中截取自己想要的值

例如一个功能接口的返回值 是一个HTML文本: 例如我们要取上图中标识的id的值,并且这个值是动态的,这是我们就需要用到正则表达式进行匹配. 如下是正则匹配的方法(代码中都有注释): 我们在真正使用的时候可以调用这个方法,然后对其中的一些值进行传参. 注意:当要去的值是动态值时,我们需要先将这个动态值定义成一个变量,如下: 再在具体的用例中给issueid赋值.

数往知来C#之接口 值类型与引用类型 静态非静态 异常处理 GC垃圾回收 值类型引用类型内存分配&lt;四&gt;

C# 基础接口篇 一.多态复习 使用个new来实现,使用virtual与override    -->new隐藏父类方法 根据当前类型,电泳对应的方法(成员)    -->override重写 无论什么情况,都是执行新的方法(成员) 继承是实现多态的一个前提,没有继承多态是不能实现的 父类与子类实现多态 抽象类与子类实现 抽象类不能实例化 抽象类中的抽象方法没有方法体 抽象类的成员有哪些   ->包含非抽象成员   ->不能实例化   ->子类必须实现父类的 抽象方法,除非子

看完这个你还不理解右值引用和移动构造 你就可以来咬我(上)

共分三篇,这是第一篇.另外两篇,看完这个你还不理解右值引用和移动构造 你就可以来咬我(中),看完这个你还不理解右值引用和移动构造 你就可以来咬我(下). C++ 右值引用 & 新特性 C++ 11中引入的一个非常重要的概念就是右值引用.理解右值引用是学习"移动语义"(move semantics)的基础.而要理解右值引用,就必须先区分左值与右值. 对左值和右值的一个最常见的误解是:等号左边的就是左值,等号右边的就是右值.左值和右值都是针对表达式而言的,左值是指表达式结束后依然存

Git.Framework 框架随手记--ORM查询返回实体对象

使用ORM有一个优势,可以通过某种机制将数据库中的数据转化为自己想要的对象形式数据.本章记录一下如何使用Git.Framework返回实体对象 一. Git.Framework 中提供的方法 在Git.Framework中有七个方法可以返回实体对象,先简答的看看这里的方法描述 (1) T GetSingle(int id); (2) T GetSingle(object value); (3) T GetSingle(T entity); (4) V GetSingle<V>(T entity

ZTree id值太大,ZTree没有生成树,ZTree的id值过大

 ZTree id值太大,ZTree没有生成树,ZTree的id值过大 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> ?Copyright 蕃薯耀 2017年7月27日 http://www.cnblogs.com/fanshuyao/ 一.问题描述: 今天使用ZTree时,从数据取出数据进行显示

利用checkbox的到值,并且存到数据库修改的话要显示之前选择的

在前台当然是利用checkbox来得到复选框的语言:{% for language in languages%}<input type="checkbox" name="language" value='{{ language.id }}' >{{ language.name }}{% endfor %}而复选框如果是已经选的在前台就展示的是选择的,那么input的属性就应该有checked 那么就可以通过在前台if来判断language.id跟已经选择

已知有个rand7()的函数,返回1到7随机自然数,让利用这个rand7()构造rand10() 随机1~10

1.int rand7()    2.{    3.  return rand()%7+1;    4.}    5.  6.int rand10()  7.{  8.    int x=0;  9.    do  10.    {  11.        x=(rand7()-1)*7+rand7();  12.    }  13.    while(x>40);  14.    return x%10+1;  15.} 分析:要保证rand10()在整数1-10的均匀分布,可以构造一个1-1

C语言:值传递,地址传递和引用传递(example:值交换)

于C语言中值传递.地址传递和引用传递的我个人理解. 通过一个例子:swap(交换两个整型变量的值)来表现! 1 #include <stdio.h> 2 void swap1(int* a,int* b); 3 void swap2(int& a,int& b); 4 void swap3(int* a,int* b); 5 6 void main(){ 7 printf("Hello World!\n"); 8 int a = 3; 9 int b = 4

Android4.0.4之后,服务器返回401或者407时,获取不到消息体的解决办法

Android4.0.4之后,服务器返回401或者407时,获取不到消息体的主要原因就是报错了,内容是: java.io.IOException: No authentication challenges found ,而导致这个异常的原因是,Android4.0.4之后,Google对服务器返回的401或者407的消息头进行了验证,如果服务器在消息头中添加了[WWW-Authenticate: XXX realm="xxx"],则没有问题,否则会在HttpURLConnection的