Menus - detonando tudo

Top Previous Next

Para personaliza 100% os seus menus (MainMenu e PopUp menu):

Autor: Flavio Junior em 11-12-2000

1. transcreva as funções abaixo para seu projeto.

2. clique em todos os items e coloque o código exemplo no evento OnDrawItem:

DesenhaItemMenu((Sender as TMenuItem), ACanvas, ARect, Selected, MenuOpcoes, True/False);

3. Se desejar aumentar o tamanho dos items (altura) digite o código no evento OnMeasureItem:

Width := ACanvas.TextWidth( (Sender as TMenuItem).Caption ) + 40;

Height := 20;

4. No MainMenu ou PopUp colocar Owner-Draw para TRUE

5. Lembre-se não associe captions "-" com estes eventos marcados acima.

6. Quando for Menus principais (topo da tela, antes de chamar a DesenhaMenuItem, passe o degrade para FALSE)

7. Have fun.

//===================================================================================================

// Tipos usados pela função:

type

// usada pelo menuopcoes

TSubMenu = record

Name : string;

Size : Integer;

Style: TFontStyles;

Color: TColor;

end;

// usado pelo DesenhaMenuItem

TMenuOpcoes = record

ItemAltura : Integer;

DegradeVisible : Boolean;

DegradeCorInicial: TColor;

DegradeCorFinal : TColor;

DegradeTam : Integer;

DeslocaTextoX : Integer;

VertText : string;

ItemFont : TSubMenu;

HotKeyFont : TSubMenu;

VertFont : TSubMenu;

SelecaoFont : TSubMenu;

SelecaoCor : TColor;

SelecaoHotKeyFont: TSubMenu;

end;

var

MenuOpcoes: TMenuOpcoes;

implementation

// Função GradientFill usada pelo DesenhaDegrade

function GradientFill(Handle: HDC; pVertex: Pointer; dwNumVertex: DWORD; pMesh: Pointer; dwNumMesh: DWORD;

dwMode: DWORD): DWORD; stdcall; external 'msimg32.dll';

//===================================================================================================

// Angulo: 90, 45, 180 ou -90, -45, -180...

procedure EscreveDiagonal(const Texto: string; const X, Y: Integer; Angulo: Integer; Superficie: TCanvas;

Fonte: string = 'Tahoma'; Tamanho: Integer = 10);

var

lf : TLogFont;

tf : TFont;

OldBkMode : integer;

begin

with Superficie do

begin

Font.Name := Fonte;

Font.Size := Tamanho;

tf := TFont.Create;

tf.Assign(Font);

GetObject(tf.Handle, sizeof(lf), @lf);

lf.lfEscapement := Angulo * 10;

lf.lfOrientation := Angulo * 10;

tf.Handle := CreateFontIndirect(lf);

Font.Assign(tf);

tf.Free;

OldBkMode := SetBkMode(Handle, TRANSPARENT); // <------ isto faz ficar transparente o text

TextOut(X, Y, Texto);

SetBkMode(Handle, OldBkMode); // <------ isto faz o texto voltar ao normal

end;

// Cor: B = Blue, G = Green, R = Red, Y = Yellow, P = Pink, S = Silver

// SuperDegrade - de cor para cor!

procedure DesenhaDegrade(ACanvas: TCanvas; const X1, Y1, X2, Y2: Integer; CorInicial: TColor = clBlack; CorFinal: TColor = clBlue; Vertical: Boolean = False);

type

_TRIVERTEX = packed record

X, Y : DWord;

Red, Green, Blue, Alpha: Word;

end;

var

udtVertex : array [0..1] of _TRIVERTEX;

RectGradient: TGradientRect;

begin

with udtVertex[0] do

begin

X := X1;

Y := Y1;

Red := GetRValue( CorInicial ) * $100;

Green := GetGValue( CorInicial ) * $100;

Blue := GetBValue( CorInicial ) * $100;

Alpha := 0;

end;

with udtVertex[1] do

begin

X := X2;

Y := Y2;

Red := GetRValue( CorFinal ) * $100;

Green := GetGValue( CorFinal ) * $100;

Blue := GetBValue( CorFinal ) * $100;

Alpha := $0000;

end;

RectGradient.UpperLeft := 0;

RectGradient.LowerRight := 1;

if Vertical then

GradientFill(ACanvas.Handle, @udtVertex, 2, @RectGradient, 1, GRADIENT_FILL_RECT_V)

else

GradientFill(ACanvas.Handle, @udtVertex, 2, @RectGradient, 1, GRADIENT_FILL_RECT_H);

end;

//===================================================================================================

// função para converter bitmaps color para cinza

procedure ConverterTonsCinza(var Bitmap: TBitmap);

var

P : ^TRGBTriple;

C, X, Y: Integer;

begin

Bitmap.PixelFormat := pf24Bit;

for y := 0 to Bitmap.Height-1 do

begin

P := Bitmap.ScanLine[y];

for x := 0 to Bitmap.Width-1 do

begin

C := Round((0.30 * P.rgbtRed) + (0.59 * P.rgbtGreen) + (0.11 * P.rgbtBlue));

P.rgbtRed := C;

P.rgbtGreen := C;

P.rgbtBlue := C;

Inc(p);

end;

//===================================================================================================

// função principal

// que personaliza o desenho dos items de menu (hotkey, fonte, degrade...)

// atencao, se quiser usar o CHECK (vezinho) coloque GroupIndex > 0 mesmo que nao for RADIO

procedure DesenhaItemMenu(MenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect; const Selected: Boolean;

const Op: TMenuOpcoes; const MenuBarra: Boolean = False); // estes é passado conforme recebido no OnDrawItem

var

Text : string;

Posicao, Altura, X, Y: Integer;

Bitm : TBitmap;

begin

// desloca o ARect 20 pixels para direita (por causa do degrade)

if Op.DegradeVisible then OffsetRect(ARect, Op.DegradeTam + 1, 0);

// tira do caption o "&"

Text := MenuItem.Caption;

Posicao := Pos('&', Text);

Text := StrTran(Text, '&', '');

// cores padrão

if MenuBarra then

ACanvas.Brush.Color := clMenuBar

else

ACanvas.Brush.Color := clMenu;

ACanvas.Font.Name := Op.ItemFont.Name;

ACanvas.Font.Size := Op.ItemFont.Size;

ACanvas.Font.Color := Op.ItemFont.Color;

ACanvas.Font.Style := Op.ItemFont.Style;

X := MenuItem.Bitmap.Width; // largura do bitmap

if Selected then // cores selecionado

begin

ACanvas.Font.Name := Op.SelecaoFont.Name;

ACanvas.Font.Size := Op.SelecaoFont.Size;

ACanvas.Font.Color := Op.SelecaoFont.Color;

ACanvas.Font.Style := Op.SelecaoFont.Style;

ACanvas.Brush.Color := Op.SelecaoCor;

end;

ACanvas.FillRect(ARect); // Preenche o fundo

// Calcula posicao vertical do caption (no meio)

Y := ARect.Top + ((Op.ItemAltura div 2) - (ACanvas.TextHeight( Text ) div 2));

if not MenuItem.Enabled then

begin

ACanvas.Font.Color := clWhite;

ACanvas.Brush.Style := bsClear;

ACanvas.TextRect(ARect, ARect.Left + X + Op.DeslocaTextoX + 1, Y + 1, Text);

ACanvas.Font.Color := clGray;

end;

// item de rádio

if (MenuItem.GroupIndex > 0) and (MenuItem.GroupIndex < 10) then X := X + 16;

ACanvas.TextRect(ARect, ARect.Left + X + Op.DeslocaTextoX, Y, Text);

// Desenha letra em destaque

if MenuItem.Enabled then

if Selected then

begin

ACanvas.Font.Name := Op.SelecaoHotKeyFont.Name;

ACanvas.Font.Size := Op.SelecaoHotKeyFont.Size;

ACanvas.Font.Color := Op.SelecaoHotKeyFont.Color;

ACanvas.Font.Style := Op.SelecaoHotKeyFont.Style;

end

else

begin

ACanvas.Font.Name := Op.HotKeyFont.Name;

ACanvas.Font.Size := Op.HotKeyFont.Size;

ACanvas.Font.Color := Op.HotKeyFont.Color;

ACanvas.Font.Style := Op.HotKeyFont.Style;

end;

ACanvas.TextOut(ARect.Left + X + Op.DeslocaTextoX + ACanvas.TextWidth(Copy(Text, 1, Length(Copy(Text,1, Posicao)) - 1)),

Y, Copy(Text, Posicao, 1));

// desenha bitmap

if MenuItem.Bitmap <> nil then

if MenuItem.Enabled then

ACanvas.Draw(ARect.Left + 2, ARect.Top + 1, MenuItem.Bitmap)

else

begin

Bitm := TBitmap.Create;

Bitm.Assign(MenuItem.Bitmap);

ConverterTonsCinza(Bitm);

ACanvas.Draw(ARect.Left + 2, ARect.Top + 1, Bitm);

Bitm.Free;

end;

// é item de menu com check?

if MenuItem.Checked then

begin

ACanvas.Brush.Color := clMenuText;

if MenuItem.RadioItem then

ACanvas.RoundRect(ARect.Left + 08, ARect.Top + (Op.ItemAltura div 2) - 3,

ARect.Left + 14, ARect.Top + (Op.ItemAltura div 2) + 3, 2, 2)

else

begin

// desenha o check

ACanvas.Pen.Width := 1;

ACanvas.Pen.Color := clMenuText;

ACanvas.MoveTo(ARect.Left + 14, ARect.Top + (Op.ItemAltura div 2) + -1);

ACanvas.LineTo(ARect.Left + 10, ARect.Top + (Op.ItemAltura div 2) + 3);

ACanvas.LineTo(ARect.Left + 07, ARect.Top + (Op.ItemAltura div 2));

ACanvas.MoveTo(ARect.Left + 14, ARect.Top + (Op.ItemAltura div 2) + -2);

ACanvas.LineTo(ARect.Left + 10, ARect.Top + (Op.ItemAltura div 2) + 2);

ACanvas.LineTo(ARect.Left + 07, ARect.Top + (Op.ItemAltura div 2) + -1);

ACanvas.MoveTo(ARect.Left + 14, ARect.Top + (Op.ItemAltura div 2) );

ACanvas.LineTo(ARect.Left + 10, ARect.Top + (Op.ItemAltura div 2) + 4);

ACanvas.LineTo(ARect.Left + 07, ARect.Top + (Op.ItemAltura div 2) + 1);

end;

// Se o degrade estiver habilitado e for o ultimo item desenha degrade.

if (Op.DegradeVisible) and (MenuItem.MenuIndex = MenuItem.Parent.Count-1) then

begin

Altura := 0;

// Calcula a altura do menu

for Y := 0 to MenuItem.Parent.Count - 1 do

if (MenuItem.Parent.Items[Y].Visible) then

if (MenuItem.Parent.Items[Y].Caption = '-') then Inc(Altura, 8) else Inc(Altura, Op.ItemAltura);

DesenhaDegrade(ACanvas, 0, 0, Op.DegradeTam, Altura, Op.DegradeCorInicial, Op.DegradeCorFinal, True);

// escreve sobre o degrade

ACanvas.Font.Name := Op.VertFont.Name;

ACanvas.Font.Size := Op.VertFont.Size;

ACanvas.Font.Color:= Op.VertFont.Color;

ACanvas.Font.Style:= Op.VertFont.Style;

EscreveDiagonal(Op.VertText, (Op.DegradeTam div 2) - (ACanvas.TextHeight( Op.VertText ) div 2) - 1 + Op.VertTextDeslocaX,

Altura - 6, 90, ACanvas, Op.VertFont.Name, Op.VertFont.Size);

end;

initialization

// define as propriedades padrão para a var menuOpcoes usada pelo DesenhaMenuItem

with MenuOpcoes do

begin

DeslocaTextoX := 6;

// Degrade

DegradeVisible := True;

DegradeTam := 18;

DegradeCorInicial:= clBlack;

DegradeCorFinal := clBlue;

// Fonte do item normal

ItemAltura := 20;

ItemFont.Name := 'Verdana';

ItemFont.Size := 8;

ItemFont.Color := clBlack;

// Fonte dos hotkeys

HotKeyFont.Name := 'Verdana';

HotKeyFont.Size := 8;

HotKeyFont.Color := clNavy;

// Fonte do item selecionado

SelecaoFont.Name := 'Verdana';

SelecaoFont.Size := 8;

SelecaoFont.Color:= clNavy;

// Fonte do texto vertical

VertText := 'Menu';

VertFont.Name := 'Tahoma';

VertFont.Size := 10;

VertFont.Color := clWhite;

VertFont.Style := [fsBold];

// Fonte do hotkey selecionado

SelecaoCor := clYellow;

SelecaoHotKeyFont.Name := 'Verdana';

SelecaoHotKeyFont.Size := 8;

SelecaoHotKeyFont.Color := clNavy;

end;

end.