| [459] | 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.
 | 
|---|