Changing Font an BackGround Color in a PopupMenu's item

[Eduardo Bitu]

How to change Font an BackGround Color in PopupMenu. Wich events to use?
Wich properties to change?

Eduardo Bitu
Brazil

[Andreas Pawlik]

>Eduardo Bitu wrote:
>
>How to change Font an BackGround Color in PopupMenu. Wich events to >use? Wich properties to change?

A look at MENUITEMINFO in Win32 API should get you started. Don't know
though if you can change everything you want in Popup menus.

__________
Andreas

[Peter Below (TeamB)]

In article <7hk7tl$57...@forums.borland.com>, Eduardo Bitu wrote:
> How to change Font an BackGround Color in PopupMenu. Wich events to use?
> Wich properties to change?
>

Set the OwnerDraw property of the TPopup menu to true and handle the
OnMeasureItem and OnDrawItem events of the menu items. If you want to
display a menu item in another font or color than the Control Panel
defaults you have to draw it yourself.

Peter Below (TeamB) 10011...@compuserve.com)
No e-mail responses, please, unless explicitly requested!

[Eduardo Bitu]

Can you write a simple source showing that?

Thank You
Peter Below (TeamB) <10011...@compuXXserve.com> escreveu na mensagem ...

[Andrew Cher]

Hi!

Eduardo Bitu <tuni...@br.homeshopping.com.br> wrote in message
news:7hn099$71...@forums.borland.com...

> Can you write a simple source showing that?

I think this is simple enough:

Font: MenuBar2000.Font.Name:= 'Verdana';

Color: MenuBar2000.Options.Color.Menu:= clBlue;

Sincerely, Andrew.

----------------------------------------------
Visit us today on the World Wide Web at:
http://www.animatedmenus.com/
----------------------------------------------

[Peter Below (TeamB)]

In article <7hn099$71...@forums.borland.com>, Eduardo Bitu wrote:
> Can you write a simple source showing that?
>

Certainly:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
Menus;

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Arial10pt1: TMenuItem;
Arial12pt1: TMenuItem;
Arial14pt1: TMenuItem;
Arial18pt1: TMenuItem;
procedure MeasureMenuitem(Sender: TObject; ACanvas: TCanvas; var
Width,
Height: Integer);
procedure DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect:
TRect;
Selected: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MeasureMenuitem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
mnu: TMenuitem;
begin
mnu := Sender As TMenuitem;
aCanvas.font.name := 'Arial';
aCanvas.font.size := mnu.tag;
width := aCanvas.TextWidth( mnu.caption )+10;
height := aCanvas.TextHeight( mnu.caption ) + 4;
end;

procedure TForm1.DrawMenuItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
mnu: TMenuitem;
begin
mnu := Sender As TMenuitem;
aCanvas.font.name := 'Arial';
aCanvas.font.size := mnu.tag;
If selected then begin
aCanvas.font.color := clRed;
aCanvas.brush.color := clAqua;
end
else begin
aCanvas.font.color := clRed;
aCanvas.brush.color := $C0FFFF;
end;
acanvas.brush.style := bsSolid;
aCanvas.fillrect( aRect );
acanvas.textrect( aRect, arect.left+4, arect.top+2, mnu.caption );
end;

end.

{
object Form1: TForm1
Left = 192
Top = 128
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PopupMenu = PopupMenu1
PixelsPerInch = 120
TextHeight = 16
object PopupMenu1: TPopupMenu
OwnerDraw = True
Left = 20
Top = 48
object Arial10pt1: TMenuItem
Tag = 10
Caption = 'Arial 10pt'
OnDrawItem = DrawMenuItem
OnMeasureItem = MeasureMenuitem
end
object Arial12pt1: TMenuItem
Tag = 12
Caption = 'Arial 12 pt'
OnDrawItem = DrawMenuItem
OnMeasureItem = MeasureMenuitem
end
object Arial14pt1: TMenuItem
Tag = 14
Caption = 'Arial 14 pt'
OnDrawItem = DrawMenuItem
OnMeasureItem = MeasureMenuitem
end
object Arial18pt1: TMenuItem
Tag = 18
Caption = 'Arial 18 pt'
OnDrawItem = DrawMenuItem
OnMeasureItem = MeasureMenuitem
end
end
end

[Eduardo Bitu]

Thanks Peter

Peter Below (TeamB) <10011...@compuXXserve.com> escreveu na mensagem ...