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;

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..1of _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;

  end;

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 + 10);

 

  // 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 > 0and (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) + 322)

    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;

  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, 8else Inc(Altura, Op.ItemAltura);

 

    DesenhaDegrade(ACanvas, 00, 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 - 690, ACanvas, Op.VertFont.Name, Op.VertFont.Size);

  end;

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.