QualityCentral

Public Report

Report From: Delphi-BCB/VCL/Action Classes [ Add a report in this area ]

Report #: 28834

Status: Closed

Buttons not transparent if ParentBackground is true and they have previously been selected

Project: Delphi

Build #: 10.0.2288.42451

Version: 10.0

Submitted By: Andrew Fiddian-Green

Report Type: Minor failure / Design problem

Date Reported: 5/7/2006 4:30:57 AM

Severity: Serious / Highly visible problem

Last Updated: 3/20/2012 2:24:39 AM

Platform: All versions

Internal Tracking #: 239975

Resolution: Cannot Reproduce (Resolution Comments)

Resolved in Build: : 14.0.3567.25216

Duplicate of: None

Voting and Rating

Overall Rating: (1 Total Rating)

5.00 out of 5

Total Votes: 1

Description

Control buttons placed on a TActionToolbar do not properly respect the ParentBackground property.

Steps to Reproduce:

OS: XP -- Themed
Version: BDS 2006 -- Delphi

1. Create a New VCL Win32 Application
2. Place a TXPManifest on TForm
3. Place a TActionManager on TForm
4. TActionManager.Style := XP Style (default value unless you have overridden it)
5. TActionManager create two TCustomActions
6. Place a TCoolbar on TForm
7. Place a TActionToolbar on TCoolbar
8. TActionToolbar.ParentBackground := true
9.TActionManager drag both TCustomActions to the TActionToolbar

Run

exp: Selecting the buttons makes the previous button draw transparent
act: Previously selected button is no longer transparent

Workarounds

You need to make two changes in the ActnCtrls unit:

1) set the Transparent property on controls

procedure TCustomActionToolBar.CreateControls;
var
  i: integer;
begin
  FreeAndNil(FScrollBtn);
  SetupDropDownBtn;
  inherited;
{afg added}
  // respect ParentBackground by setting Transparent = True
  if ParentBackground then
  begin
    i := 0;
    while ActionControls[i] <> nil do
    begin
      ActionControls[i].Transparent := True;
      inc(i);
    end;
  end;
{/afg added}
end;

2) clear the fSelected flag in MouseUp...

procedure TCustomButtonControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if Assigned(ActionClient) and (ActionClient.Action is TCustomAction) and
       ((TCustomAction(ActionClient.Action).GroupIndex = 0) or
       (TCustomAction(ActionClient.Action).AutoCheck and
       TCustomAction(ActionClient.Action).Checked)) then
    begin
      { Redraw face in-case mouse is captured }
      FState := bsUp;
      FMouseInControl := False;
{afg added}
      // clear the fSelected flag
      Selected := false;
{/afg added}
      if DoClick and not (FState in [bsExclusive, bsDown]) then
        Invalidate;
    end
    else
      if DoClick then
      begin
        SetDown(not FDown);
        if FDown then Repaint;
      end
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
      end;
    if DoClick then Click;
    UpdateTracking;
  end;
end;

Attachment

QC28834.zip

Comments

Jeremy North at 5/11/2006 8:29:04 PM -

An alternative is to create your own Action Controls and override MouseUp and after calling inherited set the Selected property to false.

Example:
procedure TJEDStyleButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  Selected := False;
end;

where TJedStyleButton is declared as:

TJedStyleButton = class(TXPStyleButton)
   ...
end;

Andrew Fiddian-Green at 5/21/2006 2:55:17 AM -

I am not sure if setting Selected := False is always the solution? If the button is a "check"button and/or a member of a group, then perhaps Selected may need to remain True?

Lars Frische at 1/18/2009 10:31:48 PM -

My workaround works as follows:

Create your own TCustomButtonControl class:

type TMyActionControlButton = class(TXPStyleButton)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
end;

procedure TMyActionControlButton.DrawBackground(var PaintRect: TRect);
begin
  if not Selected then
    inherited;
end;

For your ActionToolbar implement the OnGetControlClass event:

procedure TControlForm1.ActionToolBar1GetControlClass(
  Sender: TCustomActionBar; AnItem: TActionClient;
  var ControlClass: TCustomActionControlClass);
begin
  ControlClass := TMyActionControlButton
end;

Developer Tools

Database Tools