TControl.Perform은 되돌아오는 값이 있습니다. VCL 프레임워크가 메시지의 되돌아오는 값을 어떻게 사용하는지 보십시오. (모든 예는 여기에 있습니다.)

29543 단어
코드는 다음과 같습니다.
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;

좋은 웹페이지 즐겨찾기