Mega Code Archive
Add Graphical Bar to standard PopupMenu
<![CDATA[
Title: Add Graphical Bar to standard PopupMenu
Question: Ever wondered how to make graphical bar to popupmenu like in the Start-menu or some software has in it`s taskbar popumenu? I was thinking this too. Solution is to use ownerdrawn popupmenu. Some people think that ownerdrawn menus are much work because you must take care of all different item States and do the drawing. Not even to mention item icons and actions! This is not the case. VCL provides very easy way to implement item drawing, but this is undocumented. Let`s see how I did this...
Answer:
For those who are eager to know what is the result going to be take a look at the pic above, if you already didn't.
Looks professional? Yes, but fairly easy to archive.
THE CODE
First we need to get extra space for the gradient bar. We create OnMeasureItem event to be used by every menuitem in the popupmenu. For gradient bar, we need also calculate final size of the popumenu window's height (if you didn't know popupmenu is just special case of normal window). You need to assign these same events (OnAdvancedDrawItem explained later) for every item in the popupmenu's root. Here is the code:
===============================
{ .... TForm1 .... }
public
{ Public declarations }
PopupImage: TBitmap; { icon in the bar }
PopupHeight: Integer; { holds the popumenu height }
PopupBitmap: TBitmap; { buffer for the bar }
Drawn: Boolean; { tells us if buffer has been drawn }
end;
procedure TForm1.PopupMenuPopup(Sender: TObject);
var
i: Integer;
begin
{ initialize }
Drawn := False;
PopupHeight := 0;
with TPopupMenu(Sender) do
if (Items.Count 0) then
for i := 0 to Items.Count-1 do
begin
Items[i].OnMeasureItem := ExpandItemWidth;
Items[i].OnAdvancedDrawItem := AdvancedDrawItem;
end;
end;
procedure TForm1.ExpandItemWidth(Sender: TObject;
ACanvas: TCanvas; var Width, Height: Integer);
begin
Inc(Width, BarWidth); { make space for graphical bar }
{ way to calculate total height of menu to PopupHeight variable
which was reset at OnPopup event }
if TMenuItem(Sender).Visible then
PopupHeight := PopupHeight + Height;
end;
===============================
As I have commented in my code, we store the height of the popupmenu to PopupHeight variable. OnMeasureItem event is called for every visible item (I have the checking just in case) before menu is shown. This because windows needs to know how big window to create for popupmenu. Also change your TPopupMenu.OwnerDraw to True with Object Inspector so the events are called. To save time in building menu in designtime we assign events in runtime in OnPopup event.
Second is our OnAdvancedDrawItem event. There is a pretty nice undocumented function in VCL which can draw our items for us. It takes State as parameter (which it actually made for us and we are just calling it recursively). We need use OnAdvancedDrawItem because OnDrawItem doesn't provide us this needed parameter.
Now let's take a look at this implementation. First we have constant and some variables:
===============================
procedure TForm1.AdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
const
VerticalText = 'Winamp Slider!';
clStart: TColor = clBlue;
clEnd: TColor = clBlack;
var
i, iTmp: Integer;
r: TRect;
rc1, rc2, gc1, gc2, bc1, bc2: Byte;
ColorStart, ColorEnd: Longint;
MenuItem: TMenuItem;
===============================
Yes, you read right, we draw the vertical text dynamically, it's not a bitmap and yes again, gradient bar is drawn dynamically too just by knowing it's starting and ending colors (you can set these whatever you like).
Calling the undocumented function DrawMenuItem (can be found from Menus.pas) for a menuitem will call our event recursively unless we temporarly remove draw event. Forgetting this will eventually crash your application and probably mess with windows' internal popupwindow handlers which you can fix only by rebooting windows. This applies even the NT, so be sure not to forget.
===============================
begin
MenuItem := TMenuItem(Sender);
{ we need to remove draw event so DrawMenuItem won't generate infinite loop!
(Recursive) }
MenuItem.OnAdvancedDrawItem := nil;
{ align rect where item is draw so that vcl will leave bar for us }
r := ARect;
Dec(r.Right, BarWidth); { remove bar width }
OffsetRect(r, BarWidth, 0);
{ draw item and restore event back }
DrawMenuItem(MenuItem, ACanvas, r, State);
MenuItem.OnAdvancedDrawItem := AdvancedDrawItem;
===============================
We pass modified rect to DrawMenuItem so it draws the menuitem right place and leaves space for our bar.
(BarWidth is constant defined globally somewhere. My example uses BarWidth of 31 (pixels)).
Now our second task is to draw the gradient bar. For it we need BarSpace constant which is space left between bar and items, I have set it to 2 (pixes). This way bar looks a bit better.
Define these constants globally:
===============================
const
BarWidth = 31;
BarSpace = 2;
===============================
{ set buffer bitmap to right size }
PopupBitmap.Height := PopupHeight;
PopupBitmap.Width := BarWidth - BarSpace;
with PopupBitmap.Canvas do
if not Drawn then
begin
{ ... first draw phase ... }
end else { draw from double buffer }
begin
r := Rect(0, ARect.Top, PopupBitmap.Width, ARect.Bottom);
ACanvas.CopyRect(r, PopupBitmap.Canvas, r);
end;
{ end with }
===============================
We set the bar buffer to right size and use "with do" to make the code more clear. Drawn variable tells us which draw phase is going. We set it to True when the last menu item is drawn during the popupmenu's first draw phase. This way we can avoid flickering in the drawn bar when mouse traces through items. Moreover this allows us to refresh the bar when needed.
Second draw phase is just to copy the needed part to PopupMenu's ACanvas from the buffer.
===============================
FIRST DRAW PHASE: GRADIENT
Then comes our magical code for smooth gradient. We draw it line by line for current item using a loop from 0 to height of this menu item (ARect height).
Some basis of colors and fading (gradients). Color is constructed from there elements; red, green and blue (RGB). When we have two colors we have to fade between those just by fading every element separatly. Element gets value ranged from 0 to 255. When fading you need to calculate difference between starting color and ending color.
For example, if we had white and black colors, their color elements would be,
White
Red: 255
Green: 255
Blue: 255
Black
Red: 0
Green: 0
Blue: 0
Now, to get e.g. fade for position 50% (in this case our fade range would be from 0-100, percents) we calculate 50% of every elements difference (pseudocode):
NewRed = (BlackRed - WhiteRed) * 0.50;
NewGreen = (BlackGreen - WhiteGreen) * 0.50;
NewBlue = (BlackBlue - WhiteBlue) * 0.50;
And color which is constructed from NewRed, NewGreen, NewBlue would be our color at 50%. Here are the calculated values:
NewRed = 127.5
NewGreen = 127.5
NewBlue = 127.5
This is accurate and right. Half of the values and constructed color is grey. Now when we do this many times we want it to be fast, thus accuracy isn't so important and we can leave out decimals. Also range of the gradient can be different (which is just simple percent maths).
===============================
Brush.Style := bsSolid;
if (clStart = clEnd) then { same color, just one fillrect
required }
begin
Brush.Color := clStart;
FillRect(Rect(0, ARect.Top, BarWidth - BarSpace,
ARect.Bottom));
end else { draw smooth gradient bar part for this item }
begin
{ this way we can use windows color constants e.g. clBtnFace.
Those constant don't keep the RGB values }
ColorStart := ColorToRGB(clStart);
ColorEnd := ColorToRGB(clEnd);
{ get the color components here so they are faster to access
inside the loop }
rc1 := GetRValue(ColorStart);
gc1 := GetGValue(ColorStart);
bc1 := GetBValue(ColorStart);
rc2 := GetRValue(ColorEnd);
gc2 := GetGValue(ColorEnd);
bc2 := GetBValue(ColorEnd);
{ make sure that division by zero doesn't happen }
if PopupHeight 0 then
for i := 0 to (ARect.Bottom - ARect.Top) do
begin
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)));
FillRect(Rect(0, ARect.Top + i, BarWidth - BarSpace,
ARect.Top + i + 1));
end;
end;
===============================
WinAPI has ready made functions to get color's elements and constructing color from them, so why not to use those. Also when using VCL function ColorToRGB() we can make sure that even the windows color constants work right (for example BtnFace or clWindowText). When we have the color we just draw line of that color. There is a easy way to get multiplication with numbers between -1 .. 0 .. 1 without using slow Round() function, if you know what the multiplier is as fraction.
Normally you would probably calculate like this:
ResultValue := Round(Value * (50 / 100));
ResultValue := Round(Value * 0.50);
But this is the same and much faster to execute (actually same when you would use Trunc() instead of Round()):
ResultValue := (Value * 50) div 100;
Enough of maths.
FIRST DRAW PHASE: VERTICAL TEXT AND BAR GLYPH BITMAP
===============================
{ vertical text over gradient bar }
with Font do
begin
Name := 'Tahoma';
Size := 14;
Color := clWhite;
Style := [fsBold, fsItalic];
iTmp := Handle; { store old }
Handle := CreateRotatedFont(Font, 90);
end;
Brush.Style := bsClear;
r := Rect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom + 1);
ExtTextOut(Handle, 1, PopupHeight - PopupImage.Height - 7,
ETO_CLIPPED, @r, PChar(VerticalText), Length(VerticalText),
nil);
{ delete created font and restore old handle }
DeleteObject(Font.Handle);
Font.Handle := iTmp;
===============================
Code above draws the vertical text which is rotated 90 degrees. The magic is the CreateRotatedFont() function and here is the code for it:
===============================
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;
===============================
This function uses WinAPI function CreateFontIndirect() and returns it's result (handle to rotated font).
And the rest of the first phase code is here. I added the icon drawing so it is drawn only when last item is drawn. This way it goes over the gradient bar and can be bigger than one item height or width is.
===============================
if PopupHeight = ARect.Bottom then
begin
Drawn := True;
{ draw bitmap }
Draw(0, PopupHeight - PopupImage.Height - 6, PopupImage);
end;
{ draw the double buffered bar now }
r := Rect(0, 0, PopupBitmap.Width, ARect.Bottom);
ACanvas.CopyRect(r, PopupBitmap.Canvas, r);
===============================
PopupImage is just TBitmap loaded on startup. For example from resources. In my example I just load it from a file now. Resource version needs resource file with bitmap. Line to load bitmap from resources is commented. To include resource file which has the bitmap you use {$R} compiler directive.
===============================
{$R POPUPIMAGE.RES}
procedure TForm1.FormCreate(Sender: TObject);
var f: TFileStream;
begin
PopupBitmap := TBitmap.Create;
{ load bitmap from file, this could be resources too }
PopupImage := TBitmap.Create;
PopupImage.Transparent := True;
// PopupImage.LoadFromResourceName(hInstance, 'POPUPIMAGE1');
f := TFileStream.Create('popupicon.bmp', fmOpenRead);
PopupImage.LoadFromStream(f);
f.Free;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PopupImage.Free;
PopupBitmap.Free;
end;
===============================
This is all what you need! And result is for example like the one in my example project. You can download the example project, needed files and this artice as text:
http://Mintus.Codefield.com/download/popupmenubar.zip
I use popumenu from my Winamp Plug-In as the example popupmenu.
IMPROVMENTS AND MAKING A COMPONENT
The code isn't not optimal. It can be optimized, but I leave that for you to do. You can always improve the code by adding new features. How about having animation on the bar? Or change the whole bar bitmap when item changes? Best way to do animation would be to use thread. For more information about threads you can find from the Delphi help under the topic TThread. Threads are completely new world and that doesn't fit to this article.
If you think about making a component of this, you can download my version of the component to see one way it could be done. My component is called TBarPopupMenu. You can download it from Torry, Delphi Super Page or always the latest version directly from http://Codefield.com/home/mintus/download/BarPopupMenu.zip.
AUTHOR
I am 21-year-old Finnish Computer Science student at University of Jyvskyl in Finland.
-- Jouni Airaksinen
e-mail: Mintus@Codefield.com
Web: http://Mintus.Codefield.com/
]]>