Watch, Follow, &
Connect with Us
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;

Server Response from: ETNACODE01