Graphics in popup-menus

I want to be able to make a menu like the Start-menu on
Windows 95 / Win NT (with a vertical bitmap thing).
Is there any component around that does this or if not can
I get a hint about how to do this?
LVL 1
mortenmoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Pegasus100397Commented:
hehehehe 50 points for bitmapped menu items? With 3 screens of code to re-type here? hehehehe
0
Pegasus100397Commented:
ok, I'll bite:

unit radmenuu;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Justification1: TMenuItem;
    Left1: TMenuItem;
    Right1: TMenuItem;
    Center1: TMenuItem;
    Memo1: TMemo;
    Dummy1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    Dummy2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure JustClick(Sender: TObject);
  private
    { Private declarations }
    bmCheck, bmUncheck: TBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
FUNCTION MakeCheckBmp(C: Char): TBitmap;
VAR
  L : LongInt;
  R : TRect;
BEGIN
  L := GetMenuCheckMarkDimensions;
  Result := TBitmap.Create;
  WITH Result DO
    BEGIN
      Width  := LoWord(L);
      Height := HiWord(L);
      Canvas.FillRect(Rect(0, 0, Width, Height));
      Canvas.Font.Name := 'WingDings';
      Canvas.Font.Size := 10;
      R := Rect(0, 0, Width, Height);
      DrawText(Canvas.Handle, @C, 1, R, DT_CENTER OR DT_VCENTER);
    END;
END;

procedure TForm1.FormCreate(Sender: TObject);
VAR N : Integer;
begin
  bmCheck   := MakeCheckBmp('l'); {try 'n'}
  bmUncheck := MakeCheckBmp('m'); {try 'o'}
  Justification1.Items[2].Checked := True;
  FOR N := 2 TO 4 DO
    SetMenuItemBitmaps(Justification1.Handle, N, MF_BYPOSITION,
      bmUncheck.Handle, bmCheck.Handle);
end;

procedure TForm1.JustClick(Sender: TObject);
VAR N : Integer;
begin
  Memo1.Alignment := TAlignment((Sender AS TMenuItem).Tag);
  {don't set Checked property, else lose bitmaps in 16-bit}
  WITH Justification1 DO
    FOR N := 2 TO 4 DO
      IF Items[N] = Sender THEN
        CheckMenuItem(Handle, N, MF_BYPOSITION OR MF_CHECKED)
      ELSE CheckMenuItem(Handle,N,MF_BYPOSITION OR MF_UNCHECKED);
end;

end.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mortenmoAuthor Commented:
Maybe I didn't get how the menuitems were setup, but it didn't
work exactly as I ment. Why do you start on MenuItem 2? There
must be something I'm missing here. Can you explain how the
menu is build up?

I've increased the points, maybe 50 were a bit low yes I've never
used this before.

0
Pegasus100397Commented:
The code doesn't really reflect the correct ordering of the menu items. In order (from top to bottom) is
Dummy1
Left
Right
Center
Dummy2

I start on menu item 2 because the first item is a "dummy" menu item with no bitmap. MakeCheckBmp simply creates a bitmap to use with the menu item. Give me your email address and I can zip the entire sample and send it so you can see how it works.

What version of Delphi are you using?
0
mortenmoAuthor Commented:
I'm using Delphi 3. My address is morten@nvg.ntnu.no ;)
Thanks a lot

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.