delphi - Office 2007 Popupmenu component - Udvikleren.dk

Tags: delphi

Bruger #8254 @ 06.06.06 19:10

Jeg ville lige give Jer her på Udvikleren.dk muligheden for at få en Popupmenu component med Office 2007 farver og stil.

Den er lavet ud fra denne artikel:

http://delphi.about.com/od/vclusing/a/2007ownerdraw.htm

Håber I kan bruge den.

Source:

Kode

unit OBPopupmenu;

interface

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

type
  TOBPopupmenu = class(TPopupmenu)
  private
  public
    procedure MeasureSeparator(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
    procedure SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);
    procedure MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; Selected: Boolean);
    procedure Change(Sender: TObject; Source: TMenuItem;
      Rebuild: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;

procedure Register;

implementation

uses
  Math, JclGraphics;

procedure Register;
begin
  RegisterComponents('Office Bars', [TOBPopupmenu]);
end;

const
  RICHMENU_MARG_X                     = 4;
  RICHMENU_MARG_Y                     = 2;
  RICHMENU_SEPARATOR_LEADING          = 6;
  RICHMENU_GUTTER_WIDTH               = 26;

  RICHMENU_SEPARATOR_BACKGROUND_COLOR = $00eee7dd;
  RICHMENU_SEPARATOR_LINE_COLOR       = $00c5c5c5;
  RICHMENU_GUTTER_COLOR               = $00eeeee9;
  RICHMENU_ITEM_BACKGROUND_COLOR      = $00fafafa;
  RICHMENU_ITEM_SELECTED_COLOR        = $00e6d5cb;
  RICHMENU_FONT_COLOR                 = $006e1500;
  RICHMENU_FONT_DISABLED_COLOR        = $00dec5d8;

  RICHMENU_GRADIENT_START1            = $00efe8e4;
  RICHMENU_GRADIENT_END1              = $00dec5b8;
  RICHMENU_GRADIENT_START2            = $00d8baab;
  RICHMENU_GRADIENT_END2              = $00efe8e4;

//
//Measure width and height of a menuseparator
//
procedure TOBPopupmenu.MeasureSeparator(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  SeparatorHint: string;
  item: TMenuItem;
  r: TRect;
begin
  item := TMenuItem(sender);
  SeparatorHint := item.Hint;

  //Separator with text:
  if SeparatorHint <> '' then
  begin
    //Initialize
    r := rect(0, 0, 0, 0);
    ACanvas.Font.Style := [fsBold];

    //Make windows calculate needed space
    Height := drawText(ACanvas.Handle, PChar(SeparatorHint), length(SeparatorHint), r, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
    width := r.Right - r.Left;

    //Give some extra room for padding:
    inc(Height, RICHMENU_MARG_Y*4);
    inc(Width,  RICHMENU_MARG_X*2 + RICHMENU_SEPARATOR_LEADING);
  end
  else
  //Plain old separator:
  begin
    //Fixed height and width:
    height := 4;
    width := 10;
  end;
end;

//
// Drawing a menuseparator
//
procedure TOBPopupmenu.SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  hintStr: string;
  item: TMenuItem;
  r: TRect;
  hasGutter: boolean;
begin
  item := TMenuItem(sender);
  hasGutter := item.GetImageList <> nil;

  //Background:
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := RICHMENU_SEPARATOR_BACKGROUND_COLOR;
  ACanvas.FillRect(ARect);

  //Lines:
  ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
  ACanvas.Polyline([point(ARect.Left, ARect.Bottom-2), point(ARect.Right, ARect.Bottom-2)]);
  ACanvas.Pen.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
  ACanvas.Polyline([point(ARect.Left, ARect.Bottom-1), point(ARect.Right, ARect.Bottom-1)]);

  //Text
  hintStr := item.Hint;
  if hintStr <> '' then
  begin
    //Text:
    ACanvas.Brush.Style := bsClear;
    ACanvas.Font.Style := [fsBold];
    ACanvas.Font.Color := RICHMENU_FONT_COLOR;
    r.Left := ARect.Left + RICHMENU_MARG_X;
    if hasGutter then
      inc(r.Left, RICHMENU_SEPARATOR_LEADING);
    r.Right := ARect.Right - RICHMENU_MARG_X;
    r.Top := ARect.Top;
    r.Bottom := ARect.Bottom;
    DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_SINGLELINE	or DT_VCENTER);
  end
  else if hasGutter then
  begin
   //Gutter
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
    r := ARect;
    r.Right := RICHMENU_GUTTER_WIDTH;
    ACanvas.FillRect(r);

    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
  end;
end;

//
// Measure a menuitems width and height
//
procedure TOBPopupmenu.MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  item: TMenuItem;

  captionStr: string;
  captionRect: TRect;
  captionHeight: integer;
  captionWidth: integer;

  hintStr: string;
  hintRect: TRect;
  hintHeight: integer;
  hintWidth: integer;

  shortCutStr: string;
  shortCutRect: TRect;
  shortCutHeight: integer;
  shortCutWidth: integer;
begin
  item := TMenuItem(sender);

  //Caption
  captionStr := item.Caption;
  captionRect := rect(0, 0, 0, 0);
  ACanvas.Font.Style := [fsBold];

  captionHeight := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), captionRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
  captionWidth  := captionRect.Right - captionRect.Left;

  //Shortcut:
  shortCutStr := ShortCutToText(item.ShortCut);
  if shortCutStr <> '' then
  begin
    shortCutRect := rect(0, 0, 0, 0);
    shortCutHeight := DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), shortCutRect, DT_CALCRECT or DT_RIGHT or DT_EXTERNALLEADING);
    shortCutWidth := shortCutRect.Right - shortCutRect.Left;
    inc(captionWidth, shortCutWidth + RICHMENU_MARG_X*2);
  end;

  //Hint:
  hintRect := rect(0, 0, 0, 0);
  hintStr := item.Hint;
  ACanvas.Font.Style := [];

  hintHeight := DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), hintRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
  hintWidth  := hintRect.Right - hintRect.Left;

  width := Max(captionWidth, hintWidth) + RICHMENU_MARG_X*2;
  if item.GetImageList <> nil then
    inc(width, RICHMENU_GUTTER_WIDTH);

  height := captionHeight + hintHeight + RICHMENU_MARG_Y*4;
end;

//
// Drawing a menuitem
//
procedure TOBPopupmenu.MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  i: integer;
  hintStr: string;
  captionStr: string;
  shortCutStr: string;
  r: TRect;
  offset: integer;
  selRgn: HRGN;
  fillRgn: HRGN;
  hasGutter: boolean;
  item: TMenuItem;
begin
  item := TMenuItem(sender);
  hintStr := item.Hint;
  captionStr := item.Caption;
  hasGutter := item.GetImageList <> nil;

  //Caption-hight:
  ACanvas.Font.Style := [fsBold];
  r := rect(0, 0, 0, 0);
  offset := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_CALCRECT or DT_EXTERNALLEADING or DT_TOP);

  //Backgrount
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
  ACanvas.FillRect(ARect);

  //Gutter
  if hasGutter then
  begin
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
    r := ARect;
    r.Right := RICHMENU_GUTTER_WIDTH;
    ACanvas.FillRect(r);

    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
  end;

  //Selection
  if selected then
  begin
    //Set a rounded rectangle as clip-region
    selRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, 3, 3);
    SelectClipRgn(ACanvas.Handle, selRgn);

    if hintStr <> '' then
    begin
      //First gradient - caption
      r := ARect;
      r.Bottom := r.Top + offset + RICHMENU_MARG_Y*2;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);

      //Second gradient - description
      r.Top := r.Bottom;
      r.Bottom := ARect.Bottom;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START2, RICHMENU_GRADIENT_END2, gdVertical);
    end
    else
    begin
      //Only one gradient under captoin
      r := ARect;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);
    end;

    //Release clipregion
    SelectClipRgn(ACanvas.Handle, 0);

    //Outline selection
    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Brush.Style := bsClear;
    ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, 3, 3);
  end;

  //Caption
  ACanvas.Brush.Style := bsClear;
  ACanvas.Font.Style := [fsBold];
  if item.Enabled then
    ACanvas.Font.Color := RICHMENU_FONT_COLOR
  else
    ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
  r.Left := ARect.Left + RICHMENU_MARG_X;
  if hasGutter then
    inc(r.Left, RICHMENU_GUTTER_WIDTH);
  r.Right := ARect.Right - RICHMENU_MARG_X;
  r.Top := ARect.Top + RICHMENU_MARG_Y;
  r.Bottom := ARect.Bottom;
  DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

  //Shortcut
  shortCutStr := ShortCutToText(item.ShortCut);
  if shortCutStr <> '' then
  begin
    DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), r, DT_RIGHT or DT_EXTERNALLEADING or DT_TOP);
  end;

  //Hint
  ACanvas.Font.Style := [];
  if item.Enabled then
    ACanvas.Font.Color := RICHMENU_FONT_COLOR
  else
    ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
  r.Left := ARect.Left + RICHMENU_MARG_X;
  if hasGutter then
    inc(r.Left, RICHMENU_GUTTER_WIDTH);
  r.Right := ARect.Right - RICHMENU_MARG_X;
  r.Top := ARect.Top + offset + RICHMENU_MARG_Y*2;
  r.Bottom := ARect.Bottom;
  DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

  //Icon
  if (item.ImageIndex >= 0) and (item.GetImageList <> nil) then
  begin
    item.GetImageList.Draw(ACanvas, ARect.Left + RICHMENU_MARG_X, ARect.Top + RICHMENU_MARG_Y, item.ImageIndex);
  end;
end;

procedure TOBPopupmenu.Change(Sender: TObject; Source: TMenuItem;
  Rebuild: Boolean);
var
  i:Integer;
begin
  for i:=0 to Items.Count-1 do
  begin
    if Items[i].Caption = '-' then
    begin
      Items[i].OnDrawItem := SeparatorDrawItem;
      Items[i].OnMeasureItem := MeasureSeparator;
    end
    else
    begin
      Items[i].OnDrawItem := MenuItemDrawItem;
      Items[i].OnMeasureItem := MenuItemMeasureItem;
    end;
  end;
end;

constructor TOBPopupmenu.Create;
begin
  inherited;
  OwnerDraw := True;
  OnChange := Change;
end;

destructor TOBPopupmenu.Destroy;
begin
  inherited;
end;

end.

Sådan gør du:

1. Kopier teksten i kodeboxen ind i Notesblok.

2. Gem filen som OBPopupmenu.pas (HUSK at ændre Filetype til Alle Filer)

3. Åbn Delphi og vælg Component og derefter Install Component...

4. Klik på Browse ud for Unit file name.

5. Find filen OBPopupmenu.pas og klik OK

6. Klik OK og Ja eller OK hvis der spørges om noget mere.

7. Så skulle der være kommet en tab i component panel ved navn Office Bars. Der under ligger din nye Popupmenu med Office 2007 style.

Held og lykke med brug af componenten. Ris og ros er velkommen

Bruger #6080 @ 06.06.06 20:54

150

Hej Morten.

Tak for componenten.

Men som det også bliver skrevet på: http://delphi.about.com/od/vclusing/a/2007ownerdraw.htm

Det er et fedt component, men med nogle fejl og mangler.
Bl.a. mangler submenu? (Hvis ikke det er meningen den ikke skal styles skal man ikke kunne vælge det og der er en lille pixel fejl i nedre højre hjørne.

Det var kun de fejl/mangler som jeg opdagede ved første øjekast..

Kan dog ikke så godt li Office 2007 stylen på popupmenu'er, men ellers er den meget godt lavet.

M.v.h. Johnny Rasmussen.

Bruger #8254 @ 06.06.06 20:56

280

Submenu mangler ikke...det virker fint her...

men ja, der er mangler som jeg vil lave hvis jeg ellers kan få lavet de andre componenter om ellers dropper jeg projektet

edited: min fejl...submenu virkede før jeg lavede komponenten... jeg retter det senere, så tak...

Indlæg senest redigeret d. 06.06.2006 20:58 af Bruger #8254

Bruger #6080 @ 06.06.06 21:08

150

Lyder kanont Morten..

Glæder mig til at se en hel række Office 2007 looks..

Heeh.. Overvejer at lave et sæt Delphi 7 look-a-like..

M.v.h. Johnny Rasmussen.

Bruger #8254 @ 05.07.06 20:48

280

så er der en lille update:

Kode

unit OBPopupmenu;

interface

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

type
  TOBPopupmenu = class(TPopupmenu)
  private
  public
    procedure MeasureSeparator(Sender: TObject; ACanvas: TCanvas; var Width,
      Height: Integer);
    procedure SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
      var Width, Height: Integer);
    procedure MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; Selected: Boolean);
    procedure Change(Sender: TObject; Source: TMenuItem;
      Rebuild: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
  end;

procedure Register;

implementation

uses
  Math, JclGraphics;

procedure Register;
begin
  RegisterComponents('Office Bars', [TOBPopupmenu]);
end;

const
  RICHMENU_MARG_X                     = 4;
  RICHMENU_MARG_Y                     = 2;
  RICHMENU_SEPARATOR_LEADING          = 6;
  RICHMENU_GUTTER_WIDTH               = 26;

  RICHMENU_SEPARATOR_BACKGROUND_COLOR = $00eee7dd;
  RICHMENU_SEPARATOR_LINE_COLOR       = $00c5c5c5;
  RICHMENU_GUTTER_COLOR               = $00eeeee9;
  RICHMENU_ITEM_BACKGROUND_COLOR      = $00fafafa;
  RICHMENU_ITEM_SELECTED_COLOR        = $00e6d5cb;
  RICHMENU_FONT_COLOR                 = $006e1500;
  RICHMENU_FONT_DISABLED_COLOR        = $00dec5d8;

  RICHMENU_GRADIENT_START1            = $00efe8e4;
  RICHMENU_GRADIENT_END1              = $00dec5b8;
  RICHMENU_GRADIENT_START2            = $00d8baab;
  RICHMENU_GRADIENT_END2              = $00efe8e4;

//
//Measure width and height of a menuseparator
//
procedure TOBPopupmenu.MeasureSeparator(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  SeparatorHint: string;
  item: TMenuItem;
  r: TRect;
begin
  item := TMenuItem(sender);
  SeparatorHint := item.Hint;

  //Separator with text:
  if SeparatorHint <> '' then
  begin
    //Initialize
    r := rect(0, 0, 0, 0);
    ACanvas.Font.Style := [fsBold];

    //Make windows calculate needed space
    Height := drawText(ACanvas.Handle, PChar(SeparatorHint), length(SeparatorHint), r, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
    width := r.Right - r.Left;

    //Give some extra room for padding:
    inc(Height, RICHMENU_MARG_Y*4);
    inc(Width,  RICHMENU_MARG_X*2 + RICHMENU_SEPARATOR_LEADING);
  end
  else
  //Plain old separator:
  begin
    //Fixed height and width:
    height := 4;
    width := 10;
  end;
end;

//
// Drawing a menuseparator
//
procedure TOBPopupmenu.SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  hintStr: string;
  item: TMenuItem;
  r: TRect;
  hasGutter: boolean;
begin
  item := TMenuItem(sender);
  hasGutter := item.GetImageList <> nil;

  //Background:
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := RICHMENU_SEPARATOR_BACKGROUND_COLOR;
  ACanvas.FillRect(ARect);

  //Lines:
  ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
  ACanvas.Polyline([point(ARect.Left, ARect.Bottom-2), point(ARect.Right, ARect.Bottom-2)]);
  ACanvas.Pen.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
  ACanvas.Polyline([point(ARect.Left, ARect.Bottom-1), point(ARect.Right, ARect.Bottom-1)]);

  //Text
  hintStr := item.Hint;
  if hintStr <> '' then
  begin
    //Text:
    ACanvas.Brush.Style := bsClear;
    ACanvas.Font.Style := [fsBold];
    ACanvas.Font.Color := RICHMENU_FONT_COLOR;
    r.Left := ARect.Left + RICHMENU_MARG_X;
    if hasGutter then
      inc(r.Left, RICHMENU_SEPARATOR_LEADING);
    r.Right := ARect.Right - RICHMENU_MARG_X;
    r.Top := ARect.Top;
    r.Bottom := ARect.Bottom;
    DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_SINGLELINE	or DT_VCENTER);
  end
  else if hasGutter then
  begin
   //Gutter
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
    r := ARect;
    r.Right := RICHMENU_GUTTER_WIDTH;
    ACanvas.FillRect(r);

    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
  end;
end;

//
// Measure a menuitems width and height
//
procedure TOBPopupmenu.MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
var
  item: TMenuItem;

  captionStr: string;
  captionRect: TRect;
  captionHeight: integer;
  captionWidth: integer;

  hintStr: string;
  hintRect: TRect;
  hintHeight: integer;
  hintWidth: integer;

  shortCutStr: string;
  shortCutRect: TRect;
  shortCutHeight: integer;
  shortCutWidth: integer;
begin
  item := TMenuItem(sender);

  //Caption
  captionStr := item.Caption;
  captionRect := rect(0, 0, 0, 0);
  ACanvas.Font.Style := [fsBold];

  captionHeight := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), captionRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
  captionWidth  := captionRect.Right - captionRect.Left;

  //Shortcut:
  shortCutStr := ShortCutToText(item.ShortCut);
  if shortCutStr <> '' then
  begin
    shortCutRect := rect(0, 0, 0, 0);
    shortCutHeight := DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), shortCutRect, DT_CALCRECT or DT_RIGHT or DT_EXTERNALLEADING);
    shortCutWidth := shortCutRect.Right - shortCutRect.Left;
    inc(captionWidth, shortCutWidth + RICHMENU_MARG_X*2);
  end;

  //Hint:
  hintRect := rect(0, 0, 0, 0);
  hintStr := item.Hint;
  ACanvas.Font.Style := [];

  hintHeight := DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), hintRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
  hintWidth  := hintRect.Right - hintRect.Left;

  width := Max(captionWidth, hintWidth) + RICHMENU_MARG_X*2;
  if item.GetImageList <> nil then
    inc(width, RICHMENU_GUTTER_WIDTH);

  height := captionHeight + hintHeight + RICHMENU_MARG_Y*4;
end;

//
// Drawing a menuitem
//
procedure TOBPopupmenu.MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: Boolean);
var
  i: integer;
  hintStr: string;
  captionStr: string;
  shortCutStr: string;
  r: TRect;
  offset: integer;
  selRgn: HRGN;
  fillRgn: HRGN;
  hasGutter: boolean;
  item: TMenuItem;
begin
  item := TMenuItem(sender);
  hintStr := item.Hint;
  captionStr := item.Caption;
  hasGutter := item.GetImageList <> nil;

  //Caption-hight:
  ACanvas.Font.Style := [fsBold];
  r := rect(0, 0, 0, 0);
  offset := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_CALCRECT or DT_EXTERNALLEADING or DT_TOP);

  //Backgrount
  ACanvas.Brush.Style := bsSolid;
  ACanvas.Brush.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
  ACanvas.FillRect(ARect);

  //Gutter
  if hasGutter then
  begin
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
    r := ARect;
    r.Right := RICHMENU_GUTTER_WIDTH;
    ACanvas.FillRect(r);

    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
  end;

  //Selection
  if selected then
  begin
    //Set a rounded rectangle as clip-region
    selRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, 3, 3);
    SelectClipRgn(ACanvas.Handle, selRgn);

    if hintStr <> '' then
    begin
      //First gradient - caption
      r := ARect;
      r.Bottom := r.Top + offset + RICHMENU_MARG_Y*2;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);

      //Second gradient - description
      r.Top := r.Bottom;
      r.Bottom := ARect.Bottom;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START2, RICHMENU_GRADIENT_END2, gdVertical);
    end
    else
    begin
      //Only one gradient under captoin
      r := ARect;
      FillGradient(ACanvas.Handle, r, 256, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);
    end;

    //Release clipregion
    SelectClipRgn(ACanvas.Handle, 0);

    //Outline selection
    ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
    ACanvas.Brush.Style := bsClear;
    ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, 3, 3);
  end;

  //Caption
  ACanvas.Brush.Style := bsClear;
  ACanvas.Font.Style := [fsBold];
  if item.Enabled then
    ACanvas.Font.Color := RICHMENU_FONT_COLOR
  else
    ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
  r.Left := ARect.Left + RICHMENU_MARG_X;
  if hasGutter then
    inc(r.Left, RICHMENU_GUTTER_WIDTH);
  r.Right := ARect.Right - RICHMENU_MARG_X;
  r.Top := ARect.Top + RICHMENU_MARG_Y;
  r.Bottom := ARect.Bottom;
  DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

  //Shortcut
  shortCutStr := ShortCutToText(item.ShortCut);
  if shortCutStr <> '' then
  begin
    DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), r, DT_RIGHT or DT_EXTERNALLEADING or DT_TOP);
  end;

  //Hint
  ACanvas.Font.Style := [];
  if item.Enabled then
    ACanvas.Font.Color := RICHMENU_FONT_COLOR
  else
    ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
  r.Left := ARect.Left + RICHMENU_MARG_X;
  if hasGutter then
    inc(r.Left, RICHMENU_GUTTER_WIDTH);
  r.Right := ARect.Right - RICHMENU_MARG_X;
  r.Top := ARect.Top + offset + RICHMENU_MARG_Y*2;
  r.Bottom := ARect.Bottom;
  DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

  //Icon
  if (item.ImageIndex >= 0) and (item.GetImageList <> nil) then
  begin
    item.GetImageList.Draw(ACanvas, ARect.Left + RICHMENU_MARG_X, ARect.Top + RICHMENU_MARG_Y, item.ImageIndex);
  end;
end;

procedure TOBPopupmenu.Change(Sender: TObject; Source: TMenuItem;
  Rebuild: Boolean);
var
  i,s:Integer;
begin
  for i:=0 to Items.Count-1 do
  begin
    if Items[i].Caption = '-' then
    begin
      Items[i].OnDrawItem := SeparatorDrawItem;
      Items[i].OnMeasureItem := MeasureSeparator;
    end
    else
    begin
      Items[i].OnDrawItem := MenuItemDrawItem;
      Items[i].OnMeasureItem := MenuItemMeasureItem;
    end;
//
  for s:=0 to Items.Items[i].Count-1 do
    if Items[i].Items[s].Caption = '-' then
    begin
      Items[i].Items[s].OnDrawItem := SeparatorDrawItem;
      Items[i].Items[s].OnMeasureItem := MeasureSeparator;
    end
    else
    begin
      Items[i].Items[s].OnDrawItem := MenuItemDrawItem;
      Items[i].Items[s].OnMeasureItem := MenuItemMeasureItem;
    end;
//
  end;
end;

constructor TOBPopupmenu.Create;
begin
  inherited;
  OwnerDraw := True;
  OnChange := Change;
end;

destructor TOBPopupmenu.Destroy;
begin
  inherited;
end;

end.

Changelog:

Fixed: Nu får SubMenus også Office 2007 style

Håber det virker fint

Bruger #8985 @ 29.08.06 12:30

160

Får denne fejl:
[Fatal Error] OBPopupmenu.pas(33): File not found: 'JclGraphics.dcu'

:'(

Bruger #8254 @ 29.08.06 16:58

280

det kræver at du har JCL installeret

Office 2007 Popupmenu component

Karma barometer (30 dage)

Modtaget

Givet

Favorit hos
Forum tråde
Artikler