zoukankan      html  css  js  c++  java
  • 终于懂了: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; // 如果消息没有被处理,就要送到DefaultHandler里去
    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; // 如果有一个子控件(图形和Win控件)处理过了,就退出广播
      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;

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

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

  • 相关阅读:
    CF786E ALT
    CF704D Captain America
    [NOI2016]循环之美
    「PKUWC2018」猎人杀
    [HNOI2019]JOJO
    博客已转移
    $20200203$的数学作业
    20200202的数学作业
    NOIp 2016 选课 (DP)
    Luogu P2574 XOR的艺术 (线段树)
  • 原文地址:https://www.cnblogs.com/findumars/p/5304561.html
Copyright © 2011-2022 走看看