CODEWITHSUNDEEP
delphidelphi-xe
user1175743
user1175743

Reputation:

TActionMainMenuBar Gradient Painting

I am trying to extend the TActionMainMenuBar by creating my own component derived from this component.

One thing I am trying to do is allow a gradient to be painted along the menu bar. I have managed to do this but there is a issue with the menu items when the assigned TActionManager is set to XPStyle.

See these images with different TActionManager styles set:

Platform Default (Mouse Over and Pressed):

enter image description here enter image description here

The background appears correctly when the TActionManager is set to Platform Default, you can see the gradient show nicely through.

However when the TActionManager is set to XPStyle, the gradient is not painted correctly for some of the items, just look at the first item:

XP Style (Mouse Over and Pressed):

enter image description here enter image description here

Not a good look as you can see.

I have edited the images in Paint to give a rough idea of what I would like it to look like:

Mouse Over and Selected

enter image description here enter image description here

I think this would allow creating some interesting menu styles.

Here is the code I have so far:

unit uMyMenu;

interface

uses
  Classes,
  Types,
  Graphics,
  GraphUtil,
  ActnMan,
  ActnCtrls,
  ActnMenus,
  PlatformDefaultStyleActnCtrls,
  XPActnCtrls,
  XPStyleActnCtrls;

type
  TMyActionMenu = class(TActionMainMenuBar)
  private
    FColorStart: TColor;
    FColorEnd: TColor;

    procedure SetColorStart(AValue: TColor);
    procedure SetColorEnd(AValue: TColor);
  protected
    procedure Paint(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ColorStart: TColor read FColorStart write SetColorStart default clSkyBlue;
    property ColorEnd: TColor read FColorEnd write SetColorEnd default clHighlight;
  end;

procedure Register;

implementation

{ TMyActionMenu }

constructor TMyActionMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  SetColorStart(clSkyBlue);
  SetColorEnd(clHighlight);
  ParentBackground := True;
  ParentColor := False;
  OnPaint := Paint;
end;

destructor TMyActionMenu.Destroy;
begin
  inherited;
end;

procedure TMyActionMenu.SetColorStart(AValue: TColor);
begin
  if FColorStart <> AValue then
  begin
    FColorStart := AValue;
    Invalidate;
  end;
end;

procedure TMyActionMenu.SetColorEnd(AValue: TColor);
begin
  if FColorEnd <> AValue then
  begin
    FColorEnd := AValue;
    Invalidate;
  end;
end;

procedure TMyActionMenu.Paint(Sender: TObject);
var
  Rect: TRect;
begin
  Rect := GetClientRect;

  GradientFillCanvas(TMyActionMenu(Sender).Canvas, FColorStart,
    FColorEnd, Rect, gdVertical);
end;

procedure Register;
begin
  RegisterComponents('Standard', [TMyActionMenu]);
end;

end.

I am not sure where to begin or what to change so I look forward to seeing your comments and answers.

UPDATE

Placing the TActionMainMenuBar inside a gradient panel for example, with the ParentBackground set to True kind of works more appropriately. So I should consider using SetSubComponent and putting my TMyActionMenu into a similar panel container, and then draw the gradient onto a panel that way.

In the mean time though I will leave this question open for further comments and suggestions.

Upvotes: 3

Views: 711

Answers (1)

wp_1233996
wp_1233996

Reputation: 794

There is a Russian component which does gradient painting as well. I did not test it and I even don't know if it fullfills your requirements, but maybe you get some idea from looking at their source code. Here's the link (I used Google translate to translate the site to English): http://translate.google.com/translate?langpair=ru|en&u=http%3A%2F%2Fwww.roschinspb.narod.ru%2Fdevelop.html

Upvotes: 2

Related Questions