代码如下:
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;