cxbuttons.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,149 行 · 第 1/5 页

procedure TcxCustomButton.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  P: TPoint;
begin
  inherited DoContextPopup(MousePos, Handled);
  if not Handled then
  begin
    if (MousePos.X = -1) and (MousePos.Y = -1) then
      P := ClientToScreen(Point(0, 0))
    else
      P := ClientToScreen(MousePos);
    Handled := DoShowPopupMenu(PopupMenu, P.X, P.Y);
  end;
end;

function TcxCustomButton.DoOnDropDownMenuPopup(var APopupMenu: TPopupMenu): Boolean;
begin
  Result := False;
  if Assigned(FOnDropDownMenuPopup) then
    FOnDropDownMenuPopup(Self, APopupMenu, Result);
end;

function TcxCustomButton.DoShowPopupMenu(APopupMenu: TComponent;
  X, Y: Integer): Boolean;
begin
  Result := ShowPopupMenu(Self, APopupMenu, X, Y);
end;

function TcxCustomButton.GetGlyphClass: TcxButtonGlyphClass;
begin
  Result := TcxButtonGlyph;
end;

function TcxCustomButton.GetPainterClass: TcxCustomLookAndFeelPainterClass;
begin
  Result := GetButtonPainterClass(LookAndFeel);
end;

function TcxCustomButton.StandardButton: Boolean;
begin
  Result := False;
end;

procedure TcxCustomButton.UpdateSize;
var
  ASize: TSize;
begin
  if AutoSize then
  begin
    if csLoading in ComponentState then
      ASize := GetOptimalSize
    else
      ASize := Size(0, 0);
    SetBounds(Self.Left, Self.Top, ASize.cx, ASize.cy);
  end;
end;

//IcxMouseTrackingCaller
procedure TcxCustomButton.ButtonMouseLeave;
begin
  Perform(CM_MOUSELEAVE, 0, 0);
end;

// IcxLookAndFeelContainer
function TcxCustomButton.GetLookAndFeel: TcxLookAndFeel;
begin
  Result := LookAndFeel;
end;

procedure TcxCustomButton.Click;
begin
  if FKind = cxbkStandard then
    inherited Click
  else
  begin
    if (FKind = cxbkDropDown) and not FMenuVisible then
    begin
      if not FIsMouseClick then DoDropDownMenu;
      FIsMouseClick := False;
    end
    else
      if FIsMouseClick then FIsMouseClick := False else inherited Click;
  end;
end;

function TcxCustomButton.CanFocus: Boolean;
begin
  Result := inherited CanFocus and (CanBeFocused or (csDesigning in ComponentState));
end;

function TcxCustomButton.GetOptimalSize: TSize;
var
  ACanvas: TcxScreenCanvas;
  ACaption: TCaption;
begin
  ACanvas := TcxScreenCanvas.Create;
  try
    ACanvas.Font := Font;
    ACaption := RemoveAccelChars(Caption);
    if ACaption = '' then
      ACaption := ' ';
    Result.cx := ACanvas.TextWidth(ACaption) + ACanvas.TextWidth('R') * 3;
    Result.cy := MulDiv(ACanvas.TextHeight('Wg'), 14, 8);
  finally
    ACanvas.Free;
  end;
end;

function TcxCustomButton.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action);
  UpdateImageInfo;
end;

procedure TcxCustomButton.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  if UseSystemPaint then
    InternalRecreateWindow
  else
    Invalidate;
end;

procedure TcxCustomButton.SetButtonAutoSize(Value: Boolean);
begin
  if Value <> FAutoSize then
  begin
    FAutoSize := Value;
    UpdateSize;
  end;
end;

procedure TcxCustomButton.SetColors(const Value: TcxButtonColors);
begin
  FColors.Assign(Value);
end;

procedure TcxCustomButton.SetKind(const Value: TcxButtonKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    InternalRecreateWindow;
  end
end;

procedure TcxCustomButton.SetLookAndFeel(Value: TcxLookAndFeel);
begin
  FLookAndFeel.Assign(Value);
end;

procedure TcxCustomButton.SetPopupMenu(Value: TComponent);
var
  AIPopupMenu: IcxPopupMenu;
begin
  if (Value <> nil) and not((Value is TPopupMenu) or
    Supports(Value, IcxPopupMenu, AIPopupMenu)) then
      Value := nil;
  if FPopupMenu <> Value then
  begin
    if FPopupMenu <> nil then
      FPopupMenu.RemoveFreeNotification(Self);
    FPopupMenu := Value;
    if FPopupMenu <> nil then
      FPopupMenu.FreeNotification(Self);
  end;
end;

procedure TcxCustomButton.CheckShowMenu(const P: TPoint);
begin
  if FKind = cxbkDropDownButton then
  begin
    if PtInRect(GetMenuButtonBounds, P) then DoDropDownMenu
  end
  else
    DoDropDownMenu;
end;

function TcxCustomButton.GetButtonState: TcxButtonState;
begin
  if not Enabled then Result := cxbsDisabled
  else if FIsPressed or (FMenuVisible and (Kind = cxbkDropDown)) or
      (FDown and SpeedButtonMode) then Result := cxbsPressed
  else if FMouseInControl then Result := cxbsHot
  else if (FIsDefault or FIsFocused) and not SpeedButtonMode then Result := cxbsDefault
  else Result := cxbsNormal;
end;

function TcxCustomButton.GetMenuButtonBounds: TRect;
begin
  Result := cxNullRect;
  if Kind = cxbkStandard then Exit;
  Result := ClientRect;
  if Kind = cxbkDropDownButton then
    Result.Left := Result.Right - cxDropDownButtonWidth;
end;

function TcxCustomButton.GetSpeedButtonMode: Boolean;
begin
  Result := not FCanBeFocused or (FGroupIndex <> 0);
end;

procedure TcxCustomButton.SetAllowAllUp(AValue: Boolean);
begin
  if AValue <> FAllowAllUp then
  begin
    FAllowAllUp := AValue;
    UpdateGroup;
  end;
end;

procedure TcxCustomButton.SetCanBeFocused(AValue: Boolean);
begin
  if AValue <> FCanBeFocused then
  begin
    FCanBeFocused := AValue;
    UpdateGroup;
  end;
end;

procedure TcxCustomButton.SetDown(AValue: Boolean);
begin
  if FGroupIndex = 0 then AValue := False;
  if AValue <> FDown then
  begin
    if FDown and not FAllowAllUp and (FGroupIndex <> 0) then Exit;
    FDown := AValue;
    FIsPressed := FDown;
    if AValue then UpdateGroup;
    Invalidate;
  end;
end;

procedure TcxCustomButton.SetGroupIndex(AValue: Integer);
begin
  if AValue <> FGroupIndex then
  begin
    FGroupIndex := AValue;
    if FGroupIndex = 0 then
      Down := False
    else
      UpdateGroup;
  end;
end;

procedure TcxCustomButton.UpdateGroup;
var
  AMsg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    AMsg.Msg := CM_BUTTONPRESSED;
    AMsg.WParam := FGroupIndex;
    AMsg.LParam := Longint(Self);
    AMsg.Result := 0;
    Parent.Broadcast(AMsg);
  end;
end;

procedure TcxCustomButton.WndProc(var Message: TMessage);
var
  AButton: TMouseButton;
  AShift: TShiftState;
  X, Y: Integer;
begin
  if SpeedButtonMode and not (csDesigning in ComponentState) then
  begin
    case Message.Msg of
      WM_LBUTTONDOWN, WM_RBUTTONDOWN:
        if SpeedButtonMode then
        begin
          if Message.Msg = WM_LBUTTONDOWN then
            AButton := mbLeft
          else
            AButton := mbRight;
          AShift := KeysToShiftState(Message.WParam);
          X := Message.LParamLo;
          Y := Message.LParamHi;
          if CanBeFocused then
            SetFocus;
          MouseDown(AButton, AShift, X, Y);
          Exit;
        end;
      WM_LBUTTONDBLCLK:
        begin
          DblClick;
          Invalidate;
          Exit;
        end;
      WM_KEYUP:
        begin
          if (csDesigning in ComponentState) then
            Exit;
          if Message.WParam = VK_SPACE then
            SetDown(not FDown);
        end;
    end;
  end;
  inherited WndProc(Message);
end;

procedure TcxCustomButton.ExcludeDropDownButtonRect(var R: TRect);
begin
  if Kind = cxbkDropDownButton then
    R.Right := R.Right - cxDropDownButtonWidth + 2;
end;

procedure TcxCustomButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateSize;
end;

procedure TcxCustomButton.DoDropDownMenu;
begin
  PostMessage(Handle, CM_DROPDOWNPOPUPMENU, 0, 0);
end;

function TcxCustomButton.GetBorderRect(AState: TcxButtonState): TRect;
var
  ABorderSize: Integer;
begin
  Result := ClientRect;
  ABorderSize := GetPainterClass.ButtonBorderSize(AState);
  InflateRect(Result, -ABorderSize, -ABorderSize);
  ExcludeDropDownButtonRect(Result);
end;

function TcxCustomButton.GetContentRect: TRect;
begin
  Result := GetBorderRect(cxbsDefault)
end;

function TcxCustomButton.GetDropDownMenuAlignment(APopupPoint: TPoint;
  AEstimatedAlignment: TPopupAlignment): TPopupAlignment;
var
  ADesktopWorkArea: TRect;
begin
  Result := AEstimatedAlignment;
  ADesktopWorkArea := GetDesktopWorkArea(APopupPoint);
  if APopupPoint.X <= ADesktopWorkArea.Left then
    Result := paRight
  else
    if APopupPoint.X >= ADesktopWorkArea.Right then
      Result := paLeft;
end;

function TcxCustomButton.GetDropDownMenuPopupPoint(ADropDownMenu: TPopupMenu): TPoint;
var
  H: Integer;
begin
    Result := Point(0, Height);
    case FPopupAlignment of
      paLeft:
        Result.X := 0;
      paRight:
        Result.X := Width;
      paCenter:
        Result.X := Width shr 1;
    end;
    Result := ClientToScreen(Result);
    H := GetPopupMenuHeight(ADropDownMenu);
    if Result.Y + H > GetDesktopWorkArea(Result).Bottom then
      Dec(Result.Y, Height + H + 2);
end;

procedure TcxCustomButton.InternalPaint;
var
  AColor: TColor;
  AOffset: TPoint;
  AShift: Integer;
  AState: TcxButtonState;
  AButtonMenuState: TcxButtonState;
  ATempRect, R: TRect;
  ATheme: TdxTheme;
begin
  if StandardButton then
    Exit;
  R := ClientRect;
  if GetPainterClass = TcxWinXPLookAndFeelPainter then
  begin
    ATheme := OpenTheme(totButton);
    if (ATheme <> TC_NONE) and IsThemeBackgroundPartiallyTransparent(ATheme, BP_PUSHBUTTON, PBS_NORMAL) then
      cxDrawThemeParentBackground(Self, FCanvas, R);
  end
  else
    if LookAndFeel.SkinPainter <> nil then
      cxDrawTransparentControlBackground(Self, FCanvas, R);

  case FKind of
    cxbkDropDown:
      FIsPressed := FMenuVisible;
    cxbkDropDownButton:
      begin
        ATempRect := Rect(R.Right - cxDropDownButtonWidth, R.Top, R.Right, R.Bottom);
        ExcludeDropDownButtonRect(R);
      end;
  end;

  InitializeCanvasColors(AState, AColor);

  if Assigned(FOnGetDrawParams) then
    FOnGetDrawParams(Self, AState, AColor, FCanvas.Font);

  GetPainterClass.DrawButton(FCanvas, R, '', AState, True, AColor, FCanvas.Font.Color);

  AShift := GetPainterClass.ButtonTextShift;
  if (AState = cxbsPressed) and (AShift <> 0) then
    AOffset := Point(AShift, AShift)
  else
    AOffset := cxNullPoint;

  FCanvas.SaveClipRegion;
  try
    FCanvas.SetClipRegion(TcxRegion.Create(GetBorderRect(AState)), roSet);
    UpdateImageInfo;
    FGlyph.Draw(FControlCanvas, GetContentRect, AOffset, Caption, FLayout,
    FMargin, FSpacing, AState, DrawTextBiDiModeFlags(0),
    GetPainterClass = TcxWinXPLookAndFeelPainter{$IFDEF DELPHI7}, WordWrap{$ENDIF});
  finally
    FCanvas.RestoreClipRegion;
  end;

  if FKind = cxbkDropDownButton then
  begin
    AButtonMenuState := AState;
    if FMenuVisible then
      AButtonMenuState := cxbsPressed
    else