1.3w+
社区成员
- 全部
- Windows SDK/API
- 基础类
- ActiveX
- 数据库及相关技术
- 网络及通讯开发
- VCL组件使用和开发
- 问答
...全文
当前发帖距今超过3年，不再开放新的回复
发表回复
zly1980 2004-08-18
你去www.chinabcb.com找一下下载地址!
zly1980 2004-08-18
有控件的!XPMENU@!拖上去就可以了!
cczlp 2004-08-18
XPMenu控件最简单, 网上很多.
hitripley 2004-08-17
主人在这？suiPack不是外国软件吗？
weill 2004-07-05
最最简单的就是使用suiPack控件。
www.ccrun.com有下(较早期版本，新版本的破解下载因为程序主人在这个论坛，偶就不说了）。
www.ccrun.com有下(较早期版本，新版本的破解下载因为程序主人在这个论坛，偶就不说了）。
oishi 2004-07-05
只要把這個控件放在表單上就可以了!
oishi 2004-07-05
這個控件已經可以實現自繪菜單了!不過還有點缺點!
你自己看著改吧!
你自己看著改吧!
oishi 2004-07-05
unit XpSkin;
interface
uses
Windows, SysUtils, Classes, Controls, Menus, Graphics, Types, Forms,
ImgList;
type
TXpSkin = class(TComponent)
private { Private declarations }
FActive: Boolean;
FForm: TForm;
procedure SetActive(const Value: Boolean);
procedure AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
function IsTopMenu(AMenuItem: TObject): Boolean;
protected { Protected declarations }
procedure InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
procedure InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public { Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published { Published declarations }
property Active: Boolean read FActive write SetActive;
end;
procedure Register;
implementation
uses Math;
const
I_Indent = 5;
I_ImageWidth = 24;
I_ImageHeight = 24;
I_SplitHeight = 6;
procedure Register;
begin
RegisterComponents('Standard', [TXpSkin]);
end;
{ TXpSkin }
procedure TXpSkin.InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
var
i: Integer;
procedure ActiveMenu(AMenuItem: TMenuItem);
var
j: Integer;
begin
for j := 0 to AMenuItem.Count - 1 do
ActiveMenu(AMenuItem.Items[j]);
if AEnable then
begin
AMenuItem.OnAdvancedDrawItem := AdvancedDrawItem;
AMenuItem.OnMeasureItem := MeasureItem;
end
else
begin
AMenuItem.OnAdvancedDrawItem := nil;
AMenuItem.OnMeasureItem := nil;
end;
end;
begin
if AComp.InheritsFrom(TMenu) then
begin
TMenu(AComp).OwnerDraw := AEnable;
for i := 0 to TMenu(AComp).Items.Count - 1 do
ActiveMenu(TMenu(AComp).Items[i]);
end;
if AComp.InheritsFrom(TMenuItem) then
ActiveMenu(TMenuItem(AComp));
end;
procedure TXpSkin.InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
var
i: integer;
Comp: TComponent;
begin
for i := 0 to AForm.ComponentCount - 1 do
begin
Comp := AForm.Components[i];
InitItem(Comp, AEnable, AUpdate);
end;
end;
procedure TXpSkin.SetActive(const Value: Boolean);
begin
FActive := Value;
InitItems(FForm, Value, False);
end;
procedure TXpSkin.MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
MenuItem: TMenuItem;
ImageList: TCustomImageList;
begin
Inc(Width, I_Indent);
{ MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;}
if not IsTopMenu(Sender) then
Inc(Width, I_ImageWidth + I_Indent);
if TMenuItem(Sender).IsLine then
begin
Height := I_SplitHeight;
end
else
Height := IfThen(ACanvas.TextHeight('WWW') > I_ImageHeight,
ACanvas.TextHeight('WWW'), I_ImageHeight);
end;
procedure TXpSkin.AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
DrawImage,
TopMenu,
Selected: Boolean;
MenuItem: TMenuItem;
FRect: TRect;
sText: String;
ImageList: TCustomImageList;
Glyph: TBitmap;
OldBrushColor: TColor;
procedure DrawMenuBackGround;
begin
TopMenu := IsTopMenu(MenuItem);
Selected := odSelected in State;
if Selected or (odHotLight in State) then
begin
ACanvas.Brush.Color := $00EFD3C6;
ACanvas.Pen.Color := clBlue;
ACanvas.Rectangle(ARect);
end
else
begin
ACanvas.Brush.Color := clMenu;
ACanvas.FillRect(ARect);
if not TopMenu then
begin
ACanvas.Brush.Color := clWindow;
FRect := ARect;
Inc(FRect.Left, I_ImageWidth);
ACanvas.FillRect(FRect);
end;
end;
end;
procedure DrawMenuSplitLine;
begin
ACanvas.Brush.Color := clMenu;
Dec(FRect.Right, I_Indent - 2);
Dec(FRect.Left, 2);
Inc(FRect.Top, I_SplitHeight div 2);
FRect.Bottom := FRect.Top + 1;
ACanvas.FillRect(FRect);
end;
procedure DrawMenuText;
begin
FRect := ARect;
Inc(FRect.Left, I_Indent);
if not TopMenu then
Inc(FRect.Left, I_ImageWidth);
sText := MenuItem.Caption;
if MenuItem.IsLine then
begin
DrawMenuSplitLine;
Exit;
end;
if not MenuItem.Enabled then
ACanvas.Font.Color := clGray
else
ACanvas.Font.Color := clMenuText;
DrawText(ACanvas.Handle, PChar(sText), Length(sText),
FRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
if MenuItem.ShortCut <> 0 then
begin
Dec(FRect.Right, I_Indent * 3);
sText := ShortCutToText(MenuItem.ShortCut);
DrawText(ACanvas.Handle, PChar(sText),
Length(sText), FRect, DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
end;
end;
procedure DrawImageIcon;
begin
if DrawImage then
begin
FRect := ARect;
if Assigned(ImageList) and (MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < ImageList.Count) and not MenuItem.Checked then
begin
Inc(FRect.Left, (I_ImageWidth - ImageList.Width) div 2);
Inc(FRect.Top, (I_ImageHeight - ImageList.Height) div 2);
FRect.Right := FRect.Left + I_ImageWidth;
ImageList.Draw(ACanvas, FRect.Left, FRect.Top, MenuItem.ImageIndex,
MenuItem.Enabled);
end
else
begin
{ Draw a menu check }
FRect.Right := FRect.Left + I_ImageWidth;
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
OldBrushColor := ACanvas.Font.Color;
ACanvas.Font.Color := clBtnText;
ACanvas.Draw(FRect.Left + (FRect.Right - FRect.Left - Glyph.Width) div 2 + 1,
FRect.Top + (FRect.Bottom - FRect.Top - Glyph.Height) div 2 + 1, Glyph);
ACanvas.Font.Color := OldBrushColor;
finally
Glyph.Free;
end;
end;
end;
end;
begin
MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;
DrawImage := (ImageList <> nil) and (MenuItem.ImageIndex in [0..ImageList.Count - 1])
or MenuItem.Checked;
DrawMenuBackGround;
DrawMenuText;
DrawImageIcon;
end;
destructor TXpSkin.Destroy;
begin
InitItems(FForm, False, False);
inherited;
end;
constructor TXpSkin.Create(AOwner: TComponent);
begin
inherited;
SetDesigning(True);
FForm := AOwner as TForm;
end;
procedure TXpSkin.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
InitItem(AComponent, Operation = opInsert, False);
end;
function TXpSkin.IsTopMenu(AMenuItem: TObject): Boolean;
begin
Result := TMenuItem(AMenuItem).GetParentComponent is TMainMenu;
end;
end.
interface
uses
Windows, SysUtils, Classes, Controls, Menus, Graphics, Types, Forms,
ImgList;
type
TXpSkin = class(TComponent)
private { Private declarations }
FActive: Boolean;
FForm: TForm;
procedure SetActive(const Value: Boolean);
procedure AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
function IsTopMenu(AMenuItem: TObject): Boolean;
protected { Protected declarations }
procedure InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
procedure InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public { Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published { Published declarations }
property Active: Boolean read FActive write SetActive;
end;
procedure Register;
implementation
uses Math;
const
I_Indent = 5;
I_ImageWidth = 24;
I_ImageHeight = 24;
I_SplitHeight = 6;
procedure Register;
begin
RegisterComponents('Standard', [TXpSkin]);
end;
{ TXpSkin }
procedure TXpSkin.InitItem(AComp: TComponent; AEnable, AUpdate: boolean);
var
i: Integer;
procedure ActiveMenu(AMenuItem: TMenuItem);
var
j: Integer;
begin
for j := 0 to AMenuItem.Count - 1 do
ActiveMenu(AMenuItem.Items[j]);
if AEnable then
begin
AMenuItem.OnAdvancedDrawItem := AdvancedDrawItem;
AMenuItem.OnMeasureItem := MeasureItem;
end
else
begin
AMenuItem.OnAdvancedDrawItem := nil;
AMenuItem.OnMeasureItem := nil;
end;
end;
begin
if AComp.InheritsFrom(TMenu) then
begin
TMenu(AComp).OwnerDraw := AEnable;
for i := 0 to TMenu(AComp).Items.Count - 1 do
ActiveMenu(TMenu(AComp).Items[i]);
end;
if AComp.InheritsFrom(TMenuItem) then
ActiveMenu(TMenuItem(AComp));
end;
procedure TXpSkin.InitItems(AForm: TWinControl; AEnable, AUpdate: boolean);
var
i: integer;
Comp: TComponent;
begin
for i := 0 to AForm.ComponentCount - 1 do
begin
Comp := AForm.Components[i];
InitItem(Comp, AEnable, AUpdate);
end;
end;
procedure TXpSkin.SetActive(const Value: Boolean);
begin
FActive := Value;
InitItems(FForm, Value, False);
end;
procedure TXpSkin.MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
MenuItem: TMenuItem;
ImageList: TCustomImageList;
begin
Inc(Width, I_Indent);
{ MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;}
if not IsTopMenu(Sender) then
Inc(Width, I_ImageWidth + I_Indent);
if TMenuItem(Sender).IsLine then
begin
Height := I_SplitHeight;
end
else
Height := IfThen(ACanvas.TextHeight('WWW') > I_ImageHeight,
ACanvas.TextHeight('WWW'), I_ImageHeight);
end;
procedure TXpSkin.AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var
DrawImage,
TopMenu,
Selected: Boolean;
MenuItem: TMenuItem;
FRect: TRect;
sText: String;
ImageList: TCustomImageList;
Glyph: TBitmap;
OldBrushColor: TColor;
procedure DrawMenuBackGround;
begin
TopMenu := IsTopMenu(MenuItem);
Selected := odSelected in State;
if Selected or (odHotLight in State) then
begin
ACanvas.Brush.Color := $00EFD3C6;
ACanvas.Pen.Color := clBlue;
ACanvas.Rectangle(ARect);
end
else
begin
ACanvas.Brush.Color := clMenu;
ACanvas.FillRect(ARect);
if not TopMenu then
begin
ACanvas.Brush.Color := clWindow;
FRect := ARect;
Inc(FRect.Left, I_ImageWidth);
ACanvas.FillRect(FRect);
end;
end;
end;
procedure DrawMenuSplitLine;
begin
ACanvas.Brush.Color := clMenu;
Dec(FRect.Right, I_Indent - 2);
Dec(FRect.Left, 2);
Inc(FRect.Top, I_SplitHeight div 2);
FRect.Bottom := FRect.Top + 1;
ACanvas.FillRect(FRect);
end;
procedure DrawMenuText;
begin
FRect := ARect;
Inc(FRect.Left, I_Indent);
if not TopMenu then
Inc(FRect.Left, I_ImageWidth);
sText := MenuItem.Caption;
if MenuItem.IsLine then
begin
DrawMenuSplitLine;
Exit;
end;
if not MenuItem.Enabled then
ACanvas.Font.Color := clGray
else
ACanvas.Font.Color := clMenuText;
DrawText(ACanvas.Handle, PChar(sText), Length(sText),
FRect, DT_LEFT or DT_SINGLELINE or DT_VCENTER);
if MenuItem.ShortCut <> 0 then
begin
Dec(FRect.Right, I_Indent * 3);
sText := ShortCutToText(MenuItem.ShortCut);
DrawText(ACanvas.Handle, PChar(sText),
Length(sText), FRect, DT_RIGHT or DT_SINGLELINE or DT_VCENTER);
end;
end;
procedure DrawImageIcon;
begin
if DrawImage then
begin
FRect := ARect;
if Assigned(ImageList) and (MenuItem.ImageIndex > -1) and
(MenuItem.ImageIndex < ImageList.Count) and not MenuItem.Checked then
begin
Inc(FRect.Left, (I_ImageWidth - ImageList.Width) div 2);
Inc(FRect.Top, (I_ImageHeight - ImageList.Height) div 2);
FRect.Right := FRect.Left + I_ImageWidth;
ImageList.Draw(ACanvas, FRect.Left, FRect.Top, MenuItem.ImageIndex,
MenuItem.Enabled);
end
else
begin
{ Draw a menu check }
FRect.Right := FRect.Left + I_ImageWidth;
Glyph := TBitmap.Create;
try
Glyph.Transparent := True;
Glyph.Handle := LoadBitmap(0, PChar(OBM_CHECK));
OldBrushColor := ACanvas.Font.Color;
ACanvas.Font.Color := clBtnText;
ACanvas.Draw(FRect.Left + (FRect.Right - FRect.Left - Glyph.Width) div 2 + 1,
FRect.Top + (FRect.Bottom - FRect.Top - Glyph.Height) div 2 + 1, Glyph);
ACanvas.Font.Color := OldBrushColor;
finally
Glyph.Free;
end;
end;
end;
end;
begin
MenuItem := TMenuItem(Sender);
ImageList := MenuItem.GetImageList;
DrawImage := (ImageList <> nil) and (MenuItem.ImageIndex in [0..ImageList.Count - 1])
or MenuItem.Checked;
DrawMenuBackGround;
DrawMenuText;
DrawImageIcon;
end;
destructor TXpSkin.Destroy;
begin
InitItems(FForm, False, False);
inherited;
end;
constructor TXpSkin.Create(AOwner: TComponent);
begin
inherited;
SetDesigning(True);
FForm := AOwner as TForm;
end;
procedure TXpSkin.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
InitItem(AComponent, Operation = opInsert, False);
end;
function TXpSkin.IsTopMenu(AMenuItem: TObject): Boolean;
begin
Result := TMenuItem(AMenuItem).GetParentComponent is TMainMenu;
end;
end.
jishiping 2004-07-04
自画式的菜单。主菜单条不能自画，所以主菜单条用Toolbar来做。在BCB6中，先放一个TMainMenu在Form上，设计好TMainMenu，然后将Form的属性Menu设为空。再放一个TToolbar
在Form上，指定Toolbar的属性Menu，Flat为true，AutoSize为true，这样就完成了TToolbar
替代主菜单了。对于TMainMenu空间，指定它的Images属性，指定OwnerDraw为true，设定所
有菜单项的事件OnMeasureItem和OnDrawItem，在OnMeasureItem里指定菜单项的宽度和高度，
在OnMeasureItem里自己写代码画菜单项。
在Form上，指定Toolbar的属性Menu，Flat为true，AutoSize为true，这样就完成了TToolbar
替代主菜单了。对于TMainMenu空间，指定它的Images属性，指定OwnerDraw为true，设定所
有菜单项的事件OnMeasureItem和OnDrawItem，在OnMeasureItem里指定菜单项的宽度和高度，
在OnMeasureItem里自己写代码画菜单项。
