source: cprs/branches/GUI-config/CPRS-Lib/MenuBar.pas@ 1338

Last change on this file since 1338 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 2.2 KB
Line 
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
12unit MenuBar;
13
14interface
15
16uses
17 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
18 ToolWin, ComCtrls, Menus;
19
20type
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
34procedure Register;
35
36implementation
37
38procedure Register;
39begin
40 RegisterComponents('Samples', [TMenuBar]);
41end;
42
43{ TMenuBar }
44
45constructor TMenuBar.Create(AOwner: TComponent);
46begin
47 inherited Create(AOwner);
48 Flat := True;
49 ShowCaptions := True;
50 EdgeBorders := [];
51 ControlStyle := [csCaptureMouse, csClickEvents,
52 csDoubleClicks, csMenuEvents, csSetCaption];
53end;
54
55procedure TMenuBar.GetChildren(Proc: TGetChildProc; Root: TComponent);
56begin
57end;
58
59procedure TMenuBar.SetMenu(const Value: TMainMenu);
60var
61 i: Integer;
62 Button: TToolButton;
63begin
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];
86end;
87
88end.
Note: See TracBrowser for help on using the repository browser.