cxradiogroup.pas

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

PAS
2,138
字号
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxRadioGroupProperties read GetProperties write SetProperties;
    property ItemIndex;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDock;
    property OnStartDrag;
  end;

  { TcxFilterRadioGroupHelper }

  TcxFilterRadioGroupHelper = class(TcxFilterComboBoxHelper)
  public
    class procedure GetFilterValue(AEdit: TcxCustomEdit;
      AEditProperties: TcxCustomEditProperties; var V: Variant; var S: TCaption); override;
    class function GetSupportedFilterOperators(
      AProperties: TcxCustomEditProperties;
      AValueTypeClass: TcxValueTypeClass;
      AExtendedSet: Boolean = False): TcxFilterControlOperators; override;
    class procedure InitializeProperties(AProperties,
      AEditProperties: TcxCustomEditProperties; AHasButtons: Boolean); override;
    class procedure SetFilterValue(AEdit: TcxCustomEdit; AEditProperties: TcxCustomEditProperties;
      AValue: Variant); override;
    class function UseDisplayValue: Boolean; override;
  end;

implementation

uses
  Math, dxThemeConsts, dxThemeManager, cxVariants, cxLookAndFeelPainters,
  cxEditConsts, cxEditPaintUtils, cxEditUtils;

const
  AButtonStateMap: array [TcxRadioButtonState] of TcxButtonState =
    (cxbsDisabled, cxbsHot, cxbsNormal, cxbsPressed);

type
  TCanvasAccess = class(TCanvas);

function InternalGetShiftState: TShiftState;
var
  AKeyState: TKeyBoardState;
begin
  GetKeyboardState(AKeyState);
  Result := KeyboardStateToShiftState(AKeyState);
end;

{ TcxRadioButton }

constructor TcxRadioButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csDoubleClicks];
  FControlCanvas := TControlCanvas.Create;
  FControlCanvas.Control := Self;
  FCanvas := TcxCanvas.Create(TCanvas(FControlCanvas));
  FLookAndFeel := TcxLookAndFeel.Create(Self);
  FLookAndFeel.OnChanged := LookAndFeelChanged;
  FState := rbsNormal;
  ParentBackground := True;
  PrepareRadioButtonImageList;
end;

destructor TcxRadioButton.Destroy;
begin
  EndMouseTracking(Self);
  FreeAndNil(FLookAndFeel);
  FreeAndNil(FCanvas);
  FreeAndNil(FControlCanvas);
  inherited Destroy;
end;

function TcxRadioButton.Focused: Boolean;
begin
  Result := not(csDesigning in ComponentState) and
    inherited Focused;
end;

procedure TcxRadioButton.Invalidate;
begin
  InternalInvalidateRect(Self, Rect(0, 0, Width, Height), False);
end;

procedure TcxRadioButton.DoEnter;
begin
  inherited DoEnter;
  if not Checked and not ClicksDisabled then
  begin
    ClicksDisabled := True;
    try
      Checked := True;
    finally
      ClicksDisabled := False;
      if not (csLoading in ComponentState) then
        Click;
    end;
  end;
end;

procedure TcxRadioButton.DrawCaption(ACanvas: TcxCanvas; ANativeStyle: Boolean);

  function GetDrawTextFlags: Integer;
  begin
    Result := cxAlignLeft or cxAlignVCenter or cxShowPrefix;
    if WordWrap then
      Result := Result or cxDontClip or cxWordBreak
    else
      Result := Result or cxSingleLine;
  end;

  procedure CheckFocusRect(var R: TRect);
  begin
    if IsInplace then
    begin
      R.Top := Max(R.Top, 1);
      R.Bottom := Min(R.Bottom, Height - 1);
      R.Right := Min(R.Right, Width);
    end
    else
    begin
      R.Left := Min(R.Left, 0);
      R.Top := Min(R.Top, 0);
      R.Right := Min(R.Right, Width);
      R.Bottom := Min(R.Bottom, Height);
      if (Alignment = taLeftJustify) and (R.Right > FButtonRect.Left) then
        R.Right := FButtonRect.Left;
    end;
  end;

var
  AFlags: Integer;
  R: TRect;
begin
  ACanvas.Font.Assign(Font);
  TCanvasAccess(ACanvas.Canvas).RequiredState([csFontValid]);
  ACanvas.Font.Color := GetTextColor;

  R := GetControlRect(Self);
  if Alignment = taRightJustify then
    R.Left := FButtonRect.Right
  else
    R.Right := FButtonRect.Left;
  ACanvas.Brush.Style := bsClear;
  CorrectTextRect(R, ANativeStyle);
  AFlags := GetDrawTextFlags;
  if IsNativeBackground then
    ACanvas.Canvas.Refresh;
  ACanvas.DrawText(Caption, R, AFlags, IsDisabledTextColorAssigned or
    Supports(Self, IcxContainerInnerControl) or ANativeStyle or Enabled);
  ACanvas.Brush.Style := bsSolid;
  if Focused and (Caption <> '') then
  begin
    ACanvas.TextExtent(Caption, R, AFlags);
    InflateRect(R, 1, 1);
    Inc(R.Bottom);
    if IsInplace then
      CheckFocusRect(R);
    ACanvas.Brush.Color := Color;
    ACanvas.Font.Color := Font.Color;
    TCanvasAccess(ACanvas.Canvas).RequiredState([csFontValid]);
    ACanvas.Canvas.DrawFocusRect(R);
  end;
end;

procedure TcxRadioButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  UpdateState(ButtonTocxButton(Button), Shift, Point(X, Y));
end;

procedure TcxRadioButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  UpdateState(cxmbNone, Shift, Point(X, Y));
  BeginMouseTracking(Self, GetControlRect(Self), Self);
end;

procedure TcxRadioButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  UpdateState(ButtonTocxButton(Button), Shift, Point(X, Y));
end;

procedure TcxRadioButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = PopupMenu) then
    PopupMenu := nil;
end;

procedure TcxRadioButton.CreateHandle;
begin
  inherited CreateHandle;
  ShortUpdateState;
end;

procedure TcxRadioButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style and not BS_RADIOBUTTON or BS_OWNERDRAW;
end;

procedure TcxRadioButton.CorrectTextRect(var R: TRect; ANativeStyle: Boolean);

  function GetTextRectCorrection: TRect;
  const
    AInplaceTextRectCorrectionA: array [Boolean] of TRect = (
      (Left: 5; Top: 0; Right: 1; Bottom: 0),
      (Left: 3; Top: 0; Right: 0; Bottom: 0)
    );
    ATextRectCorrectionA: array [Boolean, TLeftRight] of TRect = (
     ((Left: 2; Top: -1; Right: 1; Bottom: 0),
      (Left: 5; Top: -1; Right: 0; Bottom: 0)),
     ((Left: 2; Top: -1; Right: 6; Bottom: 0),
      (Left: 5; Top: -1; Right: 2; Bottom: 0))
      );
    ANativeStyleTextRectCorrectionA: array [Boolean, TLeftRight] of TRect = (
     ((Left: 0; Top: -1; Right: 1; Bottom: 0),
      (Left: 3; Top: -1; Right: 0; Bottom: 0)),
     ((Left: 0; Top: -1; Right: 3; Bottom: 0),
      (Left: 3; Top: -1; Right: 0; Bottom: 0))
    );
  begin
    if IsInplace then
      Result := AInplaceTextRectCorrectionA[ANativeStyle]
    else
      if ANativeStyle then
      begin
        Result := ANativeStyleTextRectCorrectionA[WordWrap, Alignment];
        if EmulateStandardControlDrawing then
        begin
          Result.Top := 0;
          Result.Bottom := 0;
        end;
      end
      else
        Result := ATextRectCorrectionA[WordWrap, Alignment];
  end;

begin
  ExtendRect(R, GetTextRectCorrection);
end;

procedure TcxRadioButton.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
var
  P: TPoint;
begin
{$IFDEF DELPHI5}
  inherited DoContextPopup(MousePos, Handled);
{$ENDIF}
  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 TcxRadioButton.DoShowPopupMenu(APopupMenu: TComponent;
  X, Y: Integer): Boolean;
begin
  Result := ShowPopupMenu(Self, APopupMenu, X, Y);
end;

procedure TcxRadioButton.DrawBackground;
begin
  if not IsTransparentBackground then
    cxEditFillRect(Canvas, GetControlRect(Self), Color);
end;

procedure TcxRadioButton.EnabledChanged;
begin
  ShortUpdateState;
  Invalidate;
end;

function TcxRadioButton.GetTextColor: TColor;
begin
  Result := clDefault;
  if Font.Color = clWindowText then
    Result := LookAndFeel.Painter.DefaultEditorTextColor(not Enabled);
  if Result = clDefault then
  begin
    if Enabled or Supports(Self, IcxContainerInnerControl) then
      Result := Font.Color
    else
      Result := clBtnShadow;
  end;
end;

procedure TcxRadioButton.InternalPolyLine(const APoints: array of TPoint);
begin
  Canvas.Polyline(APoints);
  with APoints[High(APoints)] do
    Canvas.Pixels[X, Y] := Canvas.Pen.Color;
end;

function TcxRadioButton.IsDisabledTextColorAssigned: Boolean;
begin
  Result := LookAndFeel.Painter.DefaultEditorTextColor(True) <> clDefault;
end;

function TcxRadioButton.IsInplace: Boolean;
begin
  Result := False;
end;

function TcxRadioButton.IsNativeBackground: Boolean;
begin
  Result := IsNativeStyle and ParentBackground and not IsInplace and
    not Transparent;
end;

function TcxRadioButton.IsNativeStyle: Boolean;
begin
  Result := AreVisualStylesMustBeUsed(LookAndFeel.NativeStyle, totButton);
end;

function TcxRadioButton.IsTransparent: Boolean;
begin
  Result := Transparent and not IsInplace;
end;

function TcxRadioButton.IsTransparentBackground: Boolean;
begin
  Result := IsNativeBackground or IsTransparent;
end;

procedure TcxRadioButton.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
begin
  Invalidate;
end;

procedure TcxRadioButton.MouseEnter(AControl: TControl);
begin
  ShortUpdateState;
  BeginMouseTracking(Self, GetControlRect(Self), Self);
end;

procedure TcxRadioButton.MouseLeave(AControl: TControl);
begin
  UpdateState(cxmbNone, [], Point(-1, -1));
  EndMouseTracking(Self);
end;

procedure TcxRadioButton.Paint(ADrawOnlyFocusedState: Boolean);

  function GetBackgroundColor: TColor;
  begin
    if IsTransparentBackground then
    begin
      if LookAndFeel.SkinPainter <> nil then
        Result := clNone
      else
        Result := clDefault;
    end else
      Result := Color;
  end;

  function GetNativeState: Integer;
  const
    ANativeStateMap: array [Boolean, TcxRadioButtonState] of Integer = (
      (RBS_UNCHECKEDDISABLED, RBS_UNCHECKEDHOT, RBS_UNCHECKEDNORMAL,
      RBS_UNCHECKEDPRESSED),
      (RBS_CHECKEDDISABLED, RBS_CHECKEDHOT, RBS_CHECKEDNORMAL,
      RBS_CHECKEDPRESSED)
    );
  begin
    Result := ANativeStateMap[Checked, FState];
  end;

var
  ARadioButtonSize: TSize;
  APainter: TcxCustomLookAndFeelPainterClass;
begin
  if not ADrawOnlyFocusedState then
  begin
    if IsTransparent then
      cxDrawTransparentControlBackground(Self, Canvas, GetControlRect(Self))
    else
      if IsNativeBackground then
        cxDrawThemeParentBackground(Self, Canvas, GetControlRect(Self));
    if IsNativeStyle then
      DrawBackground;
  end;

  APainter := LookAndFeel.GetAvailablePainter(totButton);
  ARadioButtonSize := APainter.RadioButtonSize;
  FButtonRect := GetRadioButtonRect(ARadioButtonSize, IsNativeStyle);

  APainter.DrawRadioButton(Canvas, FButtonRect.Left, FButtonRect.Top,
    AButtonStateMap[State], Checked, Focused, GetBackgroundColor,
    csDesigning in ComponentState);
  Canvas.ExcludeClipRect(FButtonRect);

  if not ADrawOnlyFocusedState and not IsNativeStyle then
    DrawBackground;

  DrawCaption(Canvas, IsNativeStyle);
end;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?