| 1 | 
 | 
|---|
| 2 | {*******************************************************}
 | 
|---|
| 3 | {                                                       }
 | 
|---|
| 4 | {  Implements a TToolbar descendant that has a Menu to  }
 | 
|---|
| 5 | {  make IDE like Toolbar menus very easy.  This works   }
 | 
|---|
| 6 | {  only in Delphi 4.0                                   }
 | 
|---|
| 7 | {                                                       }
 | 
|---|
| 8 | {       Copyright (c) 1995,98 Inprise Corporation       }
 | 
|---|
| 9 | {                                                       }
 | 
|---|
| 10 | {*******************************************************}
 | 
|---|
| 11 | 
 | 
|---|
| 12 | unit MenuBar;
 | 
|---|
| 13 | 
 | 
|---|
| 14 | interface
 | 
|---|
| 15 | 
 | 
|---|
| 16 | uses
 | 
|---|
| 17 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
| 18 |   ToolWin, ComCtrls, Menus;
 | 
|---|
| 19 | 
 | 
|---|
| 20 | type
 | 
|---|
| 21 |   TMenuBar = class(TToolBar)
 | 
|---|
| 22 |   private
 | 
|---|
| 23 |     FMenu: TMainMenu;
 | 
|---|
| 24 |     procedure SetMenu(const Value: TMainMenu);
 | 
|---|
| 25 |   protected
 | 
|---|
| 26 |     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
 | 
|---|
| 27 |   public
 | 
|---|
| 28 |     constructor Create(AOwner: TComponent); override;
 | 
|---|
| 29 |   published
 | 
|---|
| 30 |     property EdgeBorders default [];
 | 
|---|
| 31 |     property Menu: TMainMenu read FMenu write SetMenu;
 | 
|---|
| 32 |   end;
 | 
|---|
| 33 | 
 | 
|---|
| 34 | procedure Register;
 | 
|---|
| 35 | 
 | 
|---|
| 36 | implementation
 | 
|---|
| 37 | 
 | 
|---|
| 38 | procedure Register;
 | 
|---|
| 39 | begin
 | 
|---|
| 40 |   RegisterComponents('Samples', [TMenuBar]);
 | 
|---|
| 41 | end;
 | 
|---|
| 42 | 
 | 
|---|
| 43 | { TMenuBar }
 | 
|---|
| 44 | 
 | 
|---|
| 45 | constructor TMenuBar.Create(AOwner: TComponent);
 | 
|---|
| 46 | begin
 | 
|---|
| 47 |   inherited Create(AOwner);
 | 
|---|
| 48 |   Flat := True;
 | 
|---|
| 49 |   ShowCaptions := True;
 | 
|---|
| 50 |   EdgeBorders := [];
 | 
|---|
| 51 |   ControlStyle := [csCaptureMouse, csClickEvents,
 | 
|---|
| 52 |     csDoubleClicks, csMenuEvents, csSetCaption];
 | 
|---|
| 53 | end;
 | 
|---|
| 54 | 
 | 
|---|
| 55 | procedure TMenuBar.GetChildren(Proc: TGetChildProc; Root: TComponent);
 | 
|---|
| 56 | begin
 | 
|---|
| 57 | end;
 | 
|---|
| 58 | 
 | 
|---|
| 59 | procedure TMenuBar.SetMenu(const Value: TMainMenu);
 | 
|---|
| 60 | var
 | 
|---|
| 61 |   i: Integer;
 | 
|---|
| 62 |   Button: TToolButton;
 | 
|---|
| 63 | begin
 | 
|---|
| 64 |   if FMenu = Value then exit;
 | 
|---|
| 65 |   if Assigned(FMenu) then
 | 
|---|
| 66 |     for i := ButtonCount - 1 downto 0 do
 | 
|---|
| 67 |       Buttons[i].Free;
 | 
|---|
| 68 |   FMenu := Value;
 | 
|---|
| 69 |   if not Assigned(FMenu) then exit;
 | 
|---|
| 70 |   for i := ButtonCount to FMenu.Items.Count - 1 do
 | 
|---|
| 71 |   begin
 | 
|---|
| 72 |     Button := TToolButton.Create(Self);
 | 
|---|
| 73 |     try
 | 
|---|
| 74 |       Button.AutoSize := True;
 | 
|---|
| 75 |       Button.Grouped := True;
 | 
|---|
| 76 |       Button.Parent := Self;
 | 
|---|
| 77 |       Buttons[i].MenuItem := FMenu.Items[i];
 | 
|---|
| 78 |     except
 | 
|---|
| 79 |       Button.Free;
 | 
|---|
| 80 |       raise;
 | 
|---|
| 81 |     end;
 | 
|---|
| 82 |   end;
 | 
|---|
| 83 |   { Copy attributes from each menu item }
 | 
|---|
| 84 |   for i := 0 to FMenu.Items.Count - 1 do
 | 
|---|
| 85 |     Buttons[i].MenuItem := FMenu.Items[i];
 | 
|---|
| 86 | end;
 | 
|---|
| 87 | 
 | 
|---|
| 88 | end.
 | 
|---|