Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 03-05-2001, 08:54 AM
Wilcox Wilcox is offline
Junior Member
 
Join Date: Jan 2001
Posts: 20
Default How can i create a gradient menu like the Startmenu in Win2K?

How can i create a gradient menu like the startmenu from Win98 or Win2k.

Thank you for help.
Reply With Quote
  #2  
Old 03-05-2001, 08:59 AM
MrBaseball34 MrBaseball34 is offline
Senior Member
 
Join Date: Jan 2001
Posts: 7,260
Default RE: How can i create a gradient menu like the Startmenu in Win2K?

Several components available on Torry's have that capability
including a few that are free.
Reply With Quote
  #3  
Old 03-05-2001, 10:48 AM
rdaniel2000 rdaniel2000 is offline
Senior Member
 
Join Date: Jul 2001
Posts: 105
Default Use AnimatedMenus, excelent component

www.animatedmenus.com
Reply With Quote
  #4  
Old 03-05-2001, 01:58 PM
k3nx k3nx is offline
Member
 
Join Date: Jul 2001
Posts: 46
Default RE: How can i create a gradient menu like the Startmenu in Win2K?

I got this one on the web somewhere

just create a new pas file and copy 'n paste the code
{ Components: TBarPopupMenu 1.0.1
================================================== =========================
Bluecave Software
(C) Copyright 2000, Jouni Airaksinen (Mintus@Codefield.com)
================================================== =========================
First Release date: 2000-06-22 (yyyy-mm-dd)
---------------------------------------------------------------------------

-- Version 1.0.1 --
- Fixed font assignment AV using elipses (...) button

-- Version 1.0.0 --

This is continued part of my article at www.delphi3000.com. Article
ID 1133, http://www.delphi3000.com/article.asp?id=1133

TBarPopupMenu component for Delphi 5. Be my guest and use it where-ever
you like, just mention my name and e-mail somewhere in your software.

Copy/Paste here,
"TBarPopupMenu, Copyright 2000: Jouni Airaksinen, Mintus@Codefield.com"

There is demo program at Demo\ directory.

New properties in TBarPopupMenu:

property Bitmap: TBitmap
Bitmap to be positioned somewhere in the popupmenu (e.g. application
logo)

property BarWidth: Integer
Width of bar on the left side of popupmenu

property BitmapOffsetX: Integer
property BitmapOffsetY: Integer
Offset values to position bitmap

property BitmapVertAlignment: TBitmapVertAlignment
property BitmapHorzAlignment: TBitmapHorzAlignment
Alignment values to position bitmap, fine tune position with Offsets

property GradientEnd: TColor
property GradientStart: TColor
Gradient colors, if set to same color is drawn with one FillRect call

property Transparent: Boolean
Transparency of Bitmap

property VerticalFont: TFont
property VerticalText: string
Vertical text and it's font on the bar

property VerticalTextOffsetY: Integer
Offset for vertical text, normally you want it to be negative e.g.
defaults to -6.


Notes about root Items:

You can't assign (well you can, but events don't get executed)
OnMeasureItem nor OnAdvancedDrawItem events to root items.
Maybe I fix this later, if someone really needs those..

Otherwise, you can use Actions and other stuff normally.

---------------------------------------------------------------------------
Questions to,

Jouni Airaksinen, (programming: Mintus@Codefield.com; personal: virgin@sci.fi)
Bluecave Software, (http://www.bluecave.net/)
Codefield.com, (http://Codefield.com/)

== DISCLAIMER ================================================== ===========

THIS CODE is free. Yes, free. I'm not going to ask any money from you.
Just mention my name in your application and you are ready to go. You may
use this in your products which are: freeware, shareware, commericalware,
whateverware.

Jouni Airaksinen (Mintus@Codefield.com)
Web: http://Codefield.com/home/mintus
================================================== ========================= }

unit BarPopupMenu;

interface

uses
Windows, SysUtils, Classes, Graphics, Menus, Forms;

const
BarSpace = 2;

type
TBitmapVertAlignment = (bvaTop, bvaBottom, bvaMiddle);
TBitmapHorzAlignment = (bhaLeft, bhaRight, bhaCenter);

TBarPopupMenu = class(TPopupMenu)
private
{ Private declarations }
FBitmap: TBitmap;
FBitmapOffsetX,
FBitmapOffsetY: Integer;
FBitmapVertAlignment: TBitmapVertAlignment;
FBitmapHorzAlignment: TBitmapHorzAlignment;

FclStart,
FclEnd: TColor;

FVerticalText: string;
FVerticalFont: TFont;
{ FVerticalTextOffsetX,}
FVerticalTextOffsetY: Integer;
FBarWidth: Integer;

PopupHeight: Integer;
Drawn: Boolean;
protected
{ Protected declarations }
procedure ExpandItemWidth(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
procedure AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
State: TOwnerDrawState);

procedure SetTransparent(Value: Boolean);
function GetTransparent: Boolean;

function GetBitmap: TBitmap;
procedure SetBitmap(Value: TBitmap);

procedure SetVerticalFont(Value: TFont);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

procedure Popup(X, Y: Integer); override;
// property OwnerDraw;
published
{ Published declarations }
property Bitmap: TBitmap read GetBitmap write SetBitmap;
property BarWidth: Integer read FBarWidth write FBarWidth default 31;
property BitmapOffsetX: Integer read FBitmapOffsetX write FBitmapOffsetX default 0;
property BitmapOffsetY: Integer read FBitmapOffsetY write FBitmapOffsetY default 0;
property BitmapVertAlignment: TBitmapVertAlignment read FBitmapVertAlignment
write FBitmapVertAlignment default bvaBottom;
property BitmapHorzAlignment: TBitmapHorzAlignment read FBitmapHorzAlignment
write FBitmapHorzAlignment default bhaLeft;
property GradientEnd: TColor read FclEnd write FclEnd default clBlack;
property GradientStart: TColor read FclStart write FclStart default clBlue;
property Transparent: Boolean read GetTransparent write SetTransparent default True;
property VerticalFont: TFont read FVerticalFont write SetVerticalFont;
property VerticalText: string read FVerticalText write FVerticalText;
property VerticalTextOffsetY: Integer read FVerticalTextOffsetY
write FVerticalTextOffsetY default -6;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Bluecave', [TBarPopupMenu]);
end;

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

OwnerDraw := True;

FBitmapOffsetX := 0;
FBitmapOffsetY := 0;
FBitmapVertAlignment := bvaBottom;
FBitmapHorzAlignment := bhaLeft;

FVerticalFont := TFont.Create;
with FVerticalFont do
begin
Name := 'Tahoma';
Size := 14;
Color := clWhite;
Style := [fsBold, fsItalic];
end;

FVerticalTextOffsetY := -6;

FclStart := clBlue;
FclEnd := clBlack;

FBarWidth := 31;

if (Application.Handle <> 0) then
FVerticalText := Application.Title; { some defaults }
end;

destructor TBarPopupMenu.Destroy;
begin
FVerticalFont.Free;
if Assigned(FBitmap) then FBitmap.Free;
inherited Destroy;
end;

procedure TBarPopupMenu.SetTransparent(Value: Boolean);
begin
if FBitmap = nil then Exit;
if (Value <> FBitmap.Transparent) then
FBitmap.Transparent := Value;
end;

function TBarPopupMenu.GetTransparent: Boolean;
begin
if FBitmap = nil then
Result := False
else
Result := FBitmap.Transparent;
end;

procedure TBarPopupMenu.SetBitmap(Value: TBitmap);
begin
if FBitmap = nil then
begin
FBitmap := TBitmap.Create;
FBitmap.Transparent := True;
end;
{ if Value = nil then
FBitmap.Free
else}
FBitmap.Assign(Value);
end;

function TBarPopupMenu.GetBitmap: TBitmap;
begin
if FBitmap = nil then
begin
FBitmap := TBitmap.Create;
FBitmap.Transparent := True;
end;
Result := FBitmap;
end;

procedure TBarPopupMenu.SetVerticalFont(Value: TFont);
begin
FVerticalFont.Assign(Value);
end;

{ ================================================== ==========================
CreateRotatedFont
Date: 2000-06-22
Description: Creates rotated font, returns handle to it
Parameters:
F: TFont, where to copy styles
Angle: Integer, font angle
---------------------------------------------------------------------------- }
function CreateRotatedFont(F: TFont; Angle: Integer): hFont;
var
LF : TLogFont;
begin
FillChar(LF, SizeOf(LF), #0);
with LF do
begin
lfHeight := F.Height;
lfWidth := 0;
lfEscapement := Angle*10;
lfOrientation := 0;
if fsBold in F.Style then
lfWeight := FW_BOLD
else
lfWeight := FW_NORMAL;
lfItalic := Byte(fsItalic in F.Style);
lfUnderline := Byte(fsUnderline in F.Style);
lfStrikeOut := Byte(fsStrikeOut in F.Style);
lfCharSet := DEFAULT_CHARSET;
StrPCopy(lfFaceName, F.Name);
lfQuality := DEFAULT_QUALITY;

lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
case F.Pitch of
fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
fpFixed: lfPitchAndFamily := FIXED_PITCH;
else
lfPitchAndFamily := DEFAULT_PITCH;
end;
end;
Result := CreateFontIndirect(LF);
end;


{ ================================================== ==========================
TBarPopupMenu.Popup
Date: 2000-06-22
Description:
Set initial events for popup items. Currently just overwrites old events..
---------------------------------------------------------------------------- }
procedure TBarPopupMenu.Popup(X, Y: Integer);
var i: Integer;
begin
PopupHeight := 0;
Drawn := False;

if (Items.Count > 0) then
for i := 0 to Items.Count-1 do
begin
Items[i].OnMeasureItem := ExpandItemWidth;
Items[i].OnAdvancedDrawItem := AdvancedDrawItem;
end;

inherited Popup(X, Y);
end;

procedure TBarPopupMenu.ExpandItemWidth(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
var
MenuItem: TMenuItem;
begin
Width := Width + FBarWidth; { make space for graphical bar }

MenuItem := TMenuItem(Sender);

if MenuItem.Visible then
PopupHeight := PopupHeight + Height;
end;

procedure TBarPopupMenu.AdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
i, itmp, x, y: Integer;
r: TRect;
rc1, rc2, gc1, gc2, bc1, bc2: Byte;
ColorStart, ColorEnd: Longint;
OnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;
MenuItem: TMenuItem;
begin
MenuItem := TMenuItem(Sender);

{ we need to remove draw event so DrawMenuItem won't generate infinite loop!
(Recursive) }
OnAdvancedDrawItem := MenuItem.OnAdvancedDrawItem;
MenuItem.OnAdvancedDrawItem := nil;

{ align rect where item is draw so that vcl will leave bar for us }
r := ARect;
r.Right := r.Right - FBarWidth; { remove bar width }
OffsetRect(r, FBarWidth, 0);

{ draw item and restore event back }
DrawMenuItem(MenuItem, ACanvas, r, State);
MenuItem.OnAdvancedDrawItem := OnAdvancedDrawItem;

if not Drawn then
begin
ACanvas.Brush.Style := bsSolid;
if (FclStart = FclEnd) then { same color, just one fillrect required }
begin
ACanvas.Brush.Color := FclStart;
ACanvas.FillRect(Rect(0, ARect.Top, FBarWidth - BarSpace, ARect.Bottom{ + 1}));
end
else { draw smooth gradient bar part for this item }
begin
ColorStart := ColorToRGB(FclStart);
ColorEnd := ColorToRGB(FclEnd);

rc1 := GetRValue(ColorStart);
gc1 := GetGValue(ColorStart);
bc1 := GetBValue(ColorStart);
rc2 := GetRValue(ColorEnd);
gc2 := GetGValue(ColorEnd);
bc2 := GetBValue(ColorEnd);

for i := 0 to (ARect.Bottom - ARect.Top) do
begin
ACanvas.Brush.Color := RGB(
(rc1 + (((rc2 - rc1) * (ARect.Top + i)) div PopupHeight)),
(gc1 + (((gc2 - gc1) * (ARect.Top + i)) div PopupHeight)),
(bc1 + (((bc2 - bc1) * (ARect.Top + i)) div PopupHeight)));
ACanvas.FillRect(Rect(0, ARect.Top + i, FBarWidth - BarSpace, ARect.Top + i + 1));
end;
end;

{ vertical text to gradient bar }
with ACanvas.Font do
begin
Assign(FVerticalFont);

itmp := Handle; { store old }
Handle := CreateRotatedFont(ACanvas.Font, 90);

x := Round((FBarWidth - ACanvas.TextHeight('X')) / 2 - 0.5); { gives much better centering }
// x := (FBarWidth - ACanvas.TextHeight('X')) div 2;
end;

ACanvas.Brush.Style := bsClear;

r := Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom + 1);

y := PopupHeight + FVerticalTextOffsetY;
if Assigned(FBitmap) and (FBitmapVertAlignment = bvaBottom) then
y := y - FBitmap.Height;

ExtTextOut(ACanvas.Handle, x - 1, y, ETO_CLIPPED,
@r, PChar(VerticalText), Length(VerticalText), nil);

{ delete created font and restore old handle }
DeleteObject(ACanvas.Font.Handle);
ACanvas.Font.Handle := itmp;

if PopupHeight = ARect.Bottom {MenuItem = MenuItem.Parent.Items[MenuItem.Parent.Count-1]} then
begin
Drawn := True;

{ draw bitmap }
if Assigned(FBitmap) then
begin
y := 0; x := 0;
case FBitmapVertAlignment of
bvaTop: y := FBitmapOffsetY;
bvaBottom: y := PopupHeight + FBitmapOffsetY - FBitmap.Height;
bvaMiddle: y := ((PopupHeight - Fbitmap.Height) div 2) + FBitmapOffsetY;
end;

case FBitmapHorzAlignment of
bhaLeft: x := FBitmapOffsetX;
bhaRight: x := (FBarWidth - BarSpace) + FBitmapOffsetX - FBitmap.Width;
bhaCenter: x := ((FBarWidth - BarSpace - FBitmap.Width) div 2) + FBitmapOffsetX;
end;

ACanvas.Draw(x, y, FBitmap);
end;
end;
end;
end;

end.
Reply With Quote
  #5  
Old 03-06-2001, 03:37 AM
Lapince Lapince is offline
Senior Member
 
Join Date: Jan 2001
Posts: 163
Default RE: How can i create a gradient menu like the Startmenu in Win2K?

First, insert an item at the bottom of your menu. Give it "-" caption (separator), so the user can't click on it. Put "mbBreak" in the break property of the second item. Finally, use OwnerDrawn menu for the first item, and draw what you want on the left side of the menu...
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 08:34 PM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2019, vBulletin Solutions, Inc.