tntbuttons.pas

TNTUniCtrlsWithExceptions UniCode 国际化语言

    end;
  except
    on E: EAbortPaint do
      ;
    else
      raise;
  end;
end;

function TTntSpeedButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

{$IFDEF COMPILER_10_UP}
type
  TAccessGraphicControl = class(TGraphicControl);
{$ENDIF}

procedure TTntSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
{$IFDEF COMPILER_10_UP}
// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
type
  CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
var
  M: TMethod;
{$ENDIF}
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  {$IFNDEF COMPILER_10_UP}
  inherited;
  {$ELSE}
  // call TGraphicControl.ActionChange (bypass TSpeedButton.ActionChange)
  M.Code := @TAccessGraphicControl.ActionChange;
  M.Data := Self;
  CallActionChange(M)(Sender, CheckDefaults);
  // call Delphi2005's TSpeedButton.ActionChange
  if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
    with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
    begin
      if CheckDefaults or (Self.GroupIndex = 0) then
        Self.GroupIndex := GroupIndex;
      { Copy image from action's imagelist }
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        CopyImage(ActionList.Images, ImageIndex);
    end;
  {$ENDIF}
end;

{ TTntBitBtn }

procedure TTntBitBtn.CreateWindowHandle(const Params: TCreateParams);
begin
  CreateUnicodeHandle(Self, Params, 'BUTTON');
end;

procedure TTntBitBtn.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntBitBtn.IsCaptionStored: Boolean;
var
  BaseClass: TClass;
  PropInfo: PPropInfo;
begin
  Assert(Self is TButton{TNT-ALLOW TButton});
  Assert(Self is TBitBtn{TNT-ALLOW TBitBtn});
  if Kind = bkCustom then
    // don't use TBitBtn, it's broken for Kind <> bkCustom
    BaseClass := TButton{TNT-ALLOW TButton}
  else begin
    //TBitBtn has it's own storage specifier, based upon the button kind
    BaseClass := TBitBtn{TNT-ALLOW TBitBtn};
  end;
  PropInfo := GetPropInfo(BaseClass, 'Caption');
  if PropInfo = nil then
    raise EPropertyError.CreateResFmt(PResStringRec(@SUnknownProperty), ['Caption']);
  Result := IsStoredProp(Self, PropInfo);
end;

function TTntBitBtn.GetCaption: TWideCaption;
begin
  Result := TntControl_GetText(Self)
end;

procedure TTntBitBtn.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;

function TTntBitBtn.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self)
end;

function TTntBitBtn.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

procedure TTntBitBtn.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TTntBitBtn.CMDialogChar(var Message: TCMDialogChar);
begin
  TntButton_CMDialogChar(Self, Message);
end;

function TTntBitBtn.GetButtonGlyph: Pointer;
begin
  Result := THackBitBtn(Self).FGlyph;
end;

procedure TTntBitBtn.UpdateInternalGlyphList;
begin
  FPaintInherited := True;
  try
    Repaint;
  finally
    FPaintInherited := False;
  end;
  Invalidate;
  raise EAbortPaint.Create('');
end;

procedure TTntBitBtn.CNDrawItem(var Message: TWMDrawItem);
begin
  if FPaintInherited then
    inherited
  else
    DrawItem(Message.DrawItemStruct^);
end;

procedure TTntBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  IsDown, IsDefault: Boolean;
  State: TButtonState;
  R: TRect;
  Flags: Longint;
  FCanvas: TCanvas;
  IsFocused: Boolean;
  {$IFDEF THEME_7_UP}
  Details: TThemedElementDetails;
  Button: TThemedButton;
  Offset: TPoint;
  {$ENDIF}
begin
  try
    FCanvas := THackBitBtn(Self).FCanvas;
    IsFocused := THackBitBtn(Self).IsFocused;
    FCanvas.Handle := DrawItemStruct.hDC;
    R := ClientRect;

    with DrawItemStruct do
    begin
      FCanvas.Handle := hDC;
      FCanvas.Font := Self.Font;
      IsDown := itemState and ODS_SELECTED <> 0;
      IsDefault := itemState and ODS_FOCUS <> 0;

      if not Enabled then State := bsDisabled
      else if IsDown then State := bsDown
      else State := bsUp;
    end;

    {$IFDEF THEME_7_UP}
    if ThemeServices.ThemesEnabled then
    begin
      if not Enabled then
        Button := tbPushButtonDisabled
      else
        if IsDown then
          Button := tbPushButtonPressed
        else
          if FMouseInControl then
            Button := tbPushButtonHot
          else
            if IsFocused or IsDefault then
              Button := tbPushButtonDefaulted
            else
              Button := tbPushButtonNormal;

      Details := ThemeServices.GetElementDetails(Button);
      // Parent background.
      ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
      // Button shape.
      ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
      R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);

      if Button = tbPushButtonPressed then
        Offset := Point(1, 0)
      else
        Offset := Point(0, 0);
      TButtonGlyph_Draw(Self, FCanvas, R, Offset, Caption, Layout, Margin, Spacing, State, False,
        DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});

      if IsFocused and IsDefault then
      begin
        FCanvas.Pen.Color := clWindowFrame;
        FCanvas.Brush.Color := clBtnFace;
        DrawFocusRect(FCanvas.Handle, R);
      end;
    end
    else
    {$ENDIF}
    begin
      R := ClientRect;

      Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
      if IsDown then Flags := Flags or DFCS_PUSHED;
      if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
        Flags := Flags or DFCS_INACTIVE;

      { DrawFrameControl doesn't allow for drawing a button as the
          default button, so it must be done here. }
      if IsFocused or IsDefault then
      begin
        FCanvas.Pen.Color := clWindowFrame;
        FCanvas.Pen.Width := 1;
        FCanvas.Brush.Style := bsClear;
        FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

        { DrawFrameControl must draw within this border }
        InflateRect(R, -1, -1);
      end;

      { DrawFrameControl does not draw a pressed button correctly }
      if IsDown then
      begin
        FCanvas.Pen.Color := clBtnShadow;
        FCanvas.Pen.Width := 1;
        FCanvas.Brush.Color := clBtnFace;
        FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
        InflateRect(R, -1, -1);
      end
      else
        DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);

      if IsFocused then
      begin
        R := ClientRect;
        InflateRect(R, -1, -1);
      end;

      FCanvas.Font := Self.Font;
      if IsDown then
        OffsetRect(R, 1, 1);

      TButtonGlyph_Draw(Self, FCanvas, R, Point(0, 0), Caption, Layout, Margin, Spacing, State,
        False, DrawTextBiDiModeFlags(0) {$IFDEF COMPILER_7_UP}, Self.WordWrap {$ENDIF});

      if IsFocused and IsDefault then
      begin
        R := ClientRect;
        InflateRect(R, -4, -4);
        FCanvas.Pen.Color := clWindowFrame;
        FCanvas.Brush.Color := clBtnFace;
        DrawFocusRect(FCanvas.Handle, R);
      end;
    end;
    FCanvas.Handle := 0;
  except
    on E: EAbortPaint do
      ;
    else
      raise;
  end;
end;

procedure TTntBitBtn.CMMouseEnter(var Message: TMessage);
begin
  FMouseInControl := True;
  inherited;
end;

procedure TTntBitBtn.CMMouseLeave(var Message: TMessage);
begin
  FMouseInControl := False;
  inherited;
end;

{$IFDEF COMPILER_10_UP}
type
  TAccessButton = class(TButton{TNT-ALLOW TButton});
{$ENDIF}

procedure TTntBitBtn.ActionChange(Sender: TObject; CheckDefaults: Boolean);
{$IFDEF COMPILER_10_UP}
// bug fix for VCL where ImageIndex on Action ALWAYS overrides the Glyph.
type
  CallActionChange = procedure(Sender: TObject; CheckDefaults: Boolean) of object;
var
  M: TMethod;
{$ENDIF}
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  {$IFNDEF COMPILER_10_UP}
  inherited;
  {$ELSE}
  // call TButton.ActionChange (bypass TBitBtn.ActionChange)
  M.Code := @TAccessButton.ActionChange;
  M.Data := Self;
  CallActionChange(M)(Sender, CheckDefaults);
  // call Delphi2005's TBitBtn.ActionChange
  if Sender is TCustomAction{TNT-ALLOW TCustomAction} then
    with TCustomAction{TNT-ALLOW TCustomAction}(Sender) do
    begin
      { Copy image from action's imagelist }
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
        CopyImage(ActionList.Images, ImageIndex);
    end;
  {$ENDIF}
end;

function TTntBitBtn.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

end.