请问Animate Menu for D6哪里有下载。51delphi那个没有d6的。 (30分)

  • 主题发起人 主题发起人 huzhaowei
  • 开始时间 开始时间
H

huzhaowei

Unregistered / Unconfirmed
GUEST, unregistred user!
下载了一个应用程序,打开后提示需要TMenuBar控件。在51delphi,delphivcl里找了,没有
51delphi那个没有d6的。
 
51delphi就有呀,Animate Menu 200这个控件
 
{*******************************************************}
{ }
{ Implements a TToolbar descendant that has a Menu to }
{ make IDE like Toolbar menus very easy. This works }
{ only in Delphi 4.0 }
{ }
{ Copyright (c) 1995,98 Inprise Corporation }
{ }
{*******************************************************}
unit MenuBar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ToolWin, ComCtrls, Menus;
type
TMenuBar = class(TToolBar)
private
FMenu: TMainMenu;
procedure SetMenu(const Value: TMainMenu);
protected
procedure GetChildren(Proc: TGetChildProc;
Root: TComponent);
override;
public
constructor Create(AOwner: TComponent);
override;
//WyL 2001-10-08
procedure Merge(aMenu: TMainMenu);
published
property EdgeBorders default [];
property Menu: TMainMenu read FMenu write SetMenu;
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('ThirdPart', [TMenuBar]);
end;

{ TMenuBar }
constructor TMenuBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Flat := True;
ShowCaptions := True;
EdgeBorders := [];
ControlStyle := [csCaptureMouse, csClickEvents,
csDoubleClicks, csMenuEvents, csSetCaption];
end;

procedure TMenuBar.GetChildren(Proc: TGetChildProc;
Root: TComponent);
begin
end;

//WyL 2001-10-08
procedure TMenuBar.Merge(aMenu: TMainMenu);
var
i, j: Integer;
Button: TToolButton;
tbtnArray: array of TToolButton;
begin
if not Assigned(FMenu) then
Exit;
for i := 0 to aMenu.Items.Count - 1 do
begin
for j := 0 to ButtonCount - 1 do
begin
if aMenu.Items.GroupIndex = Buttons[j].MenuItem.GroupIndex then
begin
SetLength(tbtnArray, High(tbtnArray) + 2);
tbtnArray[High(tbtnArray)] := Buttons[j];
end;
end;
end;
for i := 0 to High(tbtnArray) do
begin
tbtnArray.Free;
end;

if ButtonCount = 0 then
begin
Menu := aMenu;
Exit;
end;

for i := 0 to aMenu.Items.Count - 1 do
begin
for j := 0 to ButtonCount - 1 do
begin
if aMenu.Items.GroupIndex <= Buttons[j].MenuItem.GroupIndex then
begin
Button := TToolButton.Create(Self);
try
Button.AutoSize := True;
Button.Grouped := True;
Button.Parent := Self;
Button.Left := Buttons[j].Left + 1;
Button.MenuItem := aMenu.Items;
Break;
except
Button.Free;
raise;
end;
end else
begin
Button := TToolButton.Create(Self);
try
Button.AutoSize := True;
Button.Grouped := True;
Button.Parent := Self;
Button.Left := Buttons[ButtonCount - 2].Left + 1;
Button.MenuItem := aMenu.Items;
Break;
except
Button.Free;
raise;
end;
end;
end;
//For j...
end;
end;

procedure TMenuBar.SetMenu(const Value: TMainMenu);
var
i: Integer;
Button: TToolButton;
begin
if FMenu = Value then
exit;
if Assigned(FMenu) then
for i := ButtonCount - 1 do
wnto 0 do
Buttons.Free;
FMenu := Value;
if not Assigned(FMenu) then
exit;
for i := ButtonCount to FMenu.Items.Count - 1 do
begin
Button := TToolButton.Create(Self);
try
Button.AutoSize := True;
Button.Grouped := True;
Button.Parent := Self;
Buttons.MenuItem := FMenu.Items;
except
Button.Free;
raise;
end;
end;
{ Copy attributes from each menu item }
for i := 0 to FMenu.Items.Count - 1 do
Buttons.MenuItem := FMenu.Items;
end;

end.
 
多人接受答案了。
 
后退
顶部