众位前辈:如何为TMENUITEM增加COLOR 和FLAT属性,江湖后进在此先行谢过.(100分)(100分)

这两个星期以来,我一直在,为重写一个TMENU控件而无从下手
首先..在TMENU控件的ITEMS属中调用了TMENUITEM类,---我要它调用我的一个TMENUITEM的继承类例如TMENUITEM1
不知怎么办.
我对于控件开发是新手,请说的详细些,分少了一点不过,就请多将就吧.

具体的参照Menus单元里TMenu的写法。
主要是要把发布的Items换成你的类型TMenuItem1。
private
FItems: TMenuItem;
.................
published
property Items: TMenuItem read FItems;

如果你要改 ITEMS 因为items 是tmenu 中的一个属性 所有你只有改写写 tmenu
也就是说你要建一个
tmenu1 =class(TComponent);
items: yourmenuitemsclass
.............

然后再建一个 tmainmenu1:=class(tmenu1)
就可以了

你主要的是对 tmenu 的继承关系没有弄清楚...



不知你的menu 控件的继承

chshanghai,您 好:我先前就已说过了,你的思路和我的相同,我想继承关系我没有
错,我是对按照,DELPHI6源程序中的MENUS写的,可是,类可以注册但根本不在面板上显示
(我已用了注册过程注册)

GanQuan您好:问题我清楚,但我不知如何使,难道我要先写一个TMENU1 =CLASS (TMENU)
然后，将其中的ITEMS：TMENUITEMS，改成ITEMS：TMENUITEMS1，
最后，TMAINMENU1=CLASS （TMENU1），可是我试过不可以，能否给我一个
详细的说明，多谢

还有你编译通过了没有

贴出你的注册代码 就是register 哪句话

chshangshi您好,编译可以通过,注册这句话不不是完全一样
procedure Register;
begin
RegisterComponents('Samples', [TMainMenu1]);
end;

procedure Register;
begin
// RegisterComponents('Samples', [TMainMenu1]);
end;
屏蔽这句后编译一下 看是否有 取消注册 这样的提示出现
然后试
procedure Register;
begin
RegisterComponents('myvcl', [TMainMenu1]);
end;
看IDE 是否会新建一个myvcl 的 page

我已反复试过好多次了,如果我直接从TMAINMENU继承就能注册上,
但那样,我不能达到设置菜单颜色的目的,
但像一开始说的,如独立写下来太多东西了,
所以我用一个取巧的方法就是
拷贝DELPHI的MENUS源码再把其中的类全部在后面加一个1就像重写一样,
然后加上注册语句,这样编译通过,但说什么也不注册,

我试试 等会告诉你

多谢，

////////////////////////////////////////////////////////////////////////////////
// EXTMENUS //
////////////////////////////////////////////////////////////////////////////////
// Owner Drawn Menus for D2 & D3 //
////////////////////////////////////////////////////////////////////////////////
// Jean-Luc Mattei //
// jlucm@club-internet.fr //
////////////////////////////////////////////////////////////////////////////////
// IMPORTANT NOTICE : //
// //
// //
// This program is FreeWare //
// //
// Please do not release modified versions of this source code. //
// If you've made any changes that you think should have been there, //
// feel free to submit them to me at jlucm@club-internet.fr //
////////////////////////////////////////////////////////////////////////////////
// NOTES : //
// //
// * it's a test component... //
////////////////////////////////////////////////////////////////////////////////

unit ExMenus;

interface

uses Windows, SysUtils, Classes, Messages, Menus, DsgnIntf, Forms, Controls, StdCtrls, Graphics;

type
TDrawMenuItemEvent = procedure(Control: TMenu; Item: TMenuItem; Rect: TRect; State: TOwnerDrawState) of object;
TMeasureMenuItemEvent = procedure(Control: TMenu; Item: TMenuItem; var Height, Width: Integer) of object;

TMenuExtender = class(TComponent)
private
FCanvas: TCanvas;
FMenu: TMenu;
FFont: TFont;
FBrush: TBrush;
FItemHeight: Integer;
FItemWidth: Integer;
FTPUHandle: THandle;
FNewTPUtilWndProcInstance: Pointer;
FOldTPUtilWndProc: Pointer;
FNewTFormWndProcInstance: Pointer;
FOldTFormWndProc: Pointer;
FOnDrawItem: TDrawMenuItemEvent;
FOnMeasureItem: TMeasureMenuItemEvent;
FOwnerDrawAll: boolean;
protected
procedure SetMenu(Value: TMenu);
procedure SetOwnerDrawAll(Value : Boolean);
procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); virtual;
procedure MeasureItem(Index: Integer; var Height, Width: Integer); virtual;
procedure ModifyMenuTree(MenuItems : TMenuItem; OwnerDraw: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure NewTPUtilWndProc(Var Message: TMessage);
procedure NewTFormWndProc(Var Message: TMessage);
procedure SetItem(Var Item: TMenuItem; OwnerDraw: Boolean);
published
property Menu: TMenu read FMenu write SetMenu;
property OwnerDrawAll: Boolean read FOwnerDrawAll write SetOwnerDrawAll;
property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
property ItemHeigth: Integer read FItemHeight write FItemHeight;
property ItemWidth: Integer read FItemWidth write FItemWidth;
property Font: TFont read FFont write FFont;
property Color: TBrush read FBrush write FBrush;
property Canvas: TCanvas read FCanvas;
end;

TColorMenu = class(TMenuExtender)
private
protected
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ItemHeigth: Integer read FItemHeight write FItemHeight;
property ItemWidth: Integer read FItemWidth write FItemWidth;
end;

procedure Register;

implementation

const FTPUCount: Integer = 0;

{ TMenuExtender }

constructor TMenuExtender.Create(AOwner: TComponent);
Var i: Integer;
TmpHandle: THandle;
ProcessId: Pointer;
TmpProcessId: Pointer;
CName: Array [0..50] of Char;
begin
// TPUtilWindow is a @#!!##@& window created by delphi
// It's defaultProc Eats WM_DRAWITEM and WM_MEASUREITEM from Menus !!! ???
// So We Have to Override this problem like this :
//GetDeskTopWindow
inherited Create(AOwner);
// Get the Handle of this @#!!##@& window
if Not ( csDesigning in ComponentState ) then begin
Inc(FTPUCount);
if ( FTPUCount = 1 ) then begin
FTPUHandle:= FindWindow('TPUtilWindow', '');
FTPUHandle:= GetNextWindow(FTPUHandle, GW_HWNDPREV);
GetWindowThreadProcessId(Application.Handle, @ProcessId);
TmpHandle:= FTPUHandle;
repeat
FTPUHandle:= GetNextWindow(FTPUHandle, GW_HWNDNEXT);
Windows.GetClassName(FTPUHandle, CName, 50);
if ( strcomp( CName, 'TPUtilWindow') = 0 ) then begin
GetWindowThreadProcessId(FTPUHandle, @TmpProcessId);
end
else
TmpProcessId:= nil;
until ( ( FTPUHandle = 0 ) or ( TmpHandle = FTPUHandle ) or ( ProcessId = TmpProcessId ) );
if ( FTPUHandle <> 0 ) and ( ProcessId = TmpProcessId ) then begin
// Create a new proc pointer
FNewTPUtilWndProcInstance := MakeObjectInstance(NewTPUtilWndProc);
// Keep the old DefaultProc
FOldTPUtilWndProc := Pointer(GetWindowLong(FTPUHandle, GWL_WNDPROC));
// Set the new Proc
SetWindowLong(FTPUHandle, GWL_WNDPROC, Longint(FNewTPUtilWndProcInstance));
end
else Dec(FTPUCount);
end;
// if We have a main menu we need to intercept TForm messages
if ( AOwner is TForm ) then begin
FNewTFormWndProcInstance := MakeObjectInstance(NewTFormWndProc);
// Keep the old DefaultProc
FOldTFormWndProc := Pointer(GetWindowLong((Owner as TForm).Handle, GWL_WNDPROC));
// Set the new Proc
SetWindowLong((Owner as TForm).Handle, GWL_WNDPROC, Longint(FNewTFormWndProcInstance));
end;
end;
FMenu:= nil;
FCanvas:= TCanvas.Create;
FItemHeight:= 15;
FItemWidth:= 100;
FOwnerDrawAll:= False;

FFont:= TFont.Create;
FBrush:= TBrush.Create;
FBrush.Color:= clBtnFace;
FOnDrawItem:= nil;
FOnMeasureItem:= nil;
end;

destructor TMenuExtender.Destroy;
begin
FOnDrawItem:= nil;
FOnMeasureItem:= nil;
FOwnerDrawAll:= False;
Menu:= nil;
//Menu:= nil;
if Not ( csDesigning in ComponentState ) then begin
Dec(FTPUCount);
if (FTPUCount = 0 ) then begin
// We have to set back the old default Proc
SetWindowLong(FTPUHandle, GWL_WNDPROC, Longint(FOldTPUtilWndProc));
// and to release Our WndProc instance
FreeObjectInstance(FNewTPUtilWndProcInstance);
end;
if ( Owner is TForm ) then begin
//We have to set back the old default Proc of the form
SetWindowLong(FTPUHandle, GWL_WNDPROC, Longint(FOldTFormWndProc));
// and to release Our WndProc instance
FreeObjectInstance(FNewTFormWndProcInstance);
end;
end;
FFont.Free;
FBrush.Free;
FCanvas.Free;
FMenu:= nil;
inherited Destroy;
end;

procedure TMenuExtender.ModifyMenuTree(MenuItems : TMenuItem; OwnerDraw: Boolean);
Var i: Integer;
begin
if ( csDesigning in ComponentState ) then Exit;
for i:= 0 to MenuItems.Count - 1 do begin
ModifyMenuTree(MenuItems, OwnerDraw);
if ( OwnerDraw ) then begin
if ( MenuItems.Break <> mbBarBreak ) then
ModifyMenu(FMenu.Handle, MenuItems.Command, MF_BYCOMMAND or MF_OWNERDRAW, MenuItems.Command, Pointer(Self))
else
ModifyMenu(FMenu.Handle, MenuItems.Command, MF_BYCOMMAND or MF_OWNERDRAW or MF_MENUBREAK, MenuItems.Command, Pointer(Self));
end
else begin
if ( MenuItems.Break <> mbBarBreak ) then
ModifyMenu(FMenu.Handle, MenuItems.Command, MF_BYCOMMAND or MF_OWNERDRAW, MenuItems.Command, Pointer(Self))
else
ModifyMenu(FMenu.Handle, MenuItems.Command, MF_BYCOMMAND or MF_OWNERDRAW or MF_MENUBREAK, MenuItems.Command, Pointer(Self));
end;
end;
end;

procedure TMenuExtender.SetItem(Var Item: TMenuItem; OwnerDraw: Boolean);
begin
if ( FMenu <> nil ) then begin
if ( OwnerDraw ) then begin
if ( Item.Break <> mbBarBreak ) then
ModifyMenu(FMenu.Handle, Item.Command, MF_BYCOMMAND or MF_OWNERDRAW, Item.Command, Pointer(Self))
else
ModifyMenu(FMenu.Handle, Item.Command, MF_BYCOMMAND or MF_OWNERDRAW or MF_MENUBREAK, Item.Command, Pointer(Self));
end
else begin
if ( Item.Break <> mbBarBreak ) then
ModifyMenu(FMenu.Handle, Item.Command, MF_BYCOMMAND or MF_OWNERDRAW, Item.Command, Pointer(Self))
else
ModifyMenu(FMenu.Handle, Item.Command, MF_BYCOMMAND or MF_OWNERDRAW or MF_MENUBREAK, Item.Command, Pointer(Self));
end;
end;
end;

procedure TMenuExtender.SetOwnerDrawAll(Value : Boolean);
begin
if ( FOwnerDrawAll <> Value ) then begin
FOwnerDrawAll:= Value;
if ( FMenu <> nil ) then
ModifyMenuTree(FMenu.Items, FOwnerDrawAll);
end;
end;

procedure TMenuExtender.SetMenu(Value: TMenu);
Var i: Integer;
begin
if ( FMenu <> Value ) then begin
if ( FMenu <> nil ) and ( Value = nil ) then begin
ModifyMenuTree(FMenu.Items, False);
end
else begin
if ( OwnerDrawAll ) then begin
if ( FMenu = nil ) and ( Value <> nil ) then begin
FMenu:= Value;
ModifyMenuTree(FMenu.Items, True);
end;
end;
end;
FMenu:= Value;
end;
end;

procedure TMenuExtender.WMDrawItem(var Message: TWMDrawItem);
begin
CNDrawItem(Message);
end;

procedure TMenuExtender.CNDrawItem(var Message: TWMDrawItem);
var State : TOwnerDrawState;
SavedDC: Integer;
begin
with Message.DrawItemStruct^ do begin
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
SavedDC:= SaveDC(hDC);
FCanvas.Handle:= hDC;
FCanvas.Font:= FFont;
FCanvas.Brush:= FBrush;
if (Integer(itemID) >= 0) and (odSelected in State) then begin
FCanvas.Brush.Color := clHighlight;
FCanvas.Font.Color := clHighlightText
end;
if Integer(itemID) >= 0 then
DrawItem(itemID, rcItem, State)
else
FCanvas.FillRect(rcItem);
if odFocused in State then
DrawFocusRect(hDC, rcItem);
FCanvas.Handle := 0;
RestoreDC(hDC, SavedDC);
end;
Message.Result:= longint(true);
end;

procedure TMenuExtender.WMMeasureItem(var Message: TWMMeasureItem);
begin
CNMeasureItem(Message);
end;

procedure TMenuExtender.CNMeasureItem(var Message: TWMMeasureItem);
begin
with Message.MeasureItemStruct^ do begin
itemHeight := FItemHeight;
itemWidth := FItemWidth;
MeasureItem(itemID, Integer(itemHeight), Integer(itemWidth));
Message.Result:= longint(true);
end;
end;

procedure TMenuExtender.NewTPUtilWndProc(Var Message: TMessage);
begin
// Only used to handle WM_DRAWITEM and WM_MEASUREITEM from Menus
//if ( FMenu <> nil ) then begin
case Message.Msg of
WM_DRAWITEM : if ( TWMDrawItem(Message).DrawItemStruct^.CtlType = ODT_MENU ) then begin
if ( TWMDrawItem(Message).DrawItemStruct^.itemData <> 0 ) then begin
TMenuExtender(TWMDrawItem(Message).DrawItemStruct^.itemData).Dispatch(Message);
end;
end;
WM_MEASUREITEM : if ( TWMMeasureItem(Message).idCtl = 0 ) then begin
if ( TWMMeasureItem(Message).MeasureItemStruct^.itemData <> 0 ) then begin
TMenuExtender(TWMMeasureItem(Message).MeasureItemStruct^.itemData).Dispatch(Message);
end;
end;
end;
//end;
// else we call the old DefaultProc.
Message.Result:= CallWindowProc(FOldTPUtilWndProc, FTPUHandle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMenuExtender.NewTFormWndProc(Var Message: TMessage);
begin
// Only used to handle WM_DRAWITEM and WM_MEASUREITEM from Menus
if ( FMenu <> nil ) then begin
case Message.Msg of
WM_DRAWITEM : if ( TWMDrawItem(Message).DrawItemStruct^.CtlType = ODT_MENU ) then begin
if ( TWMDrawItem(Message).DrawItemStruct^.itemData <> 0 ) then begin
TMenuExtender(TWMDrawItem(Message).DrawItemStruct^.itemData).Dispatch(Message);
end;
end;
WM_MEASUREITEM : if ( TWMMeasureItem(Message).idCtl = 0 ) then begin
if ( TWMMeasureItem(Message).MeasureItemStruct^.itemData <> 0 ) then begin
TMenuExtender(TWMMeasureItem(Message).MeasureItemStruct^.itemData).Dispatch(Message);
end;
end;
end;
end;
// else we call the old DefaultProc.
Message.Result:= CallWindowProc(FOldTFormWndProc, (Owner as TForm).Handle, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMenuExtender.MeasureItem(Index: Integer; var Height, Width: Integer);
Var Item: TMenuItem;
begin
Item:= FMenu.FindItem(Index, fkCommand);
if Assigned(FOnMeasureItem) then
FOnMeasureItem(FMenu, Item, Height, Width)
end;

procedure TMenuExtender.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
Var Item: TMenuItem;
Mark: String[5];
C : Array[0..100] of char;
begin
Item:= FMenu.FindItem(Index, fkCommand);
if Assigned(FOnDrawItem) then
FOnDrawItem(FMenu, Item, Rect, State)
else
begin
FCanvas.FillRect(Rect);
Mark:= '';
Rect.Left:= Rect.Left + 5;
if ( Item.Checked ) then
if ( Item.RadioItem ) then
Mark:= '*'
else
Mark:= '+';
if ( Item.Default ) then
Canvas.Font.Style:= [fsBold];
if Not ( ( FMenu is TMainMenu ) and ( Fmenu.Items.IndexOf(Item) <> -1 ) ) then begin
DrawText(Canvas.Handle, StrPCopy(C, Mark), -1, Rect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
Rect.Left:= Rect.Left + 20;
end;
DrawText(Canvas.Handle, StrPCopy(C, Item.Caption), -1, Rect, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
end;
end;

constructor TColorMenu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OwnerDrawAll:= True;
end;

destructor TColorMenu.Destroy;
begin
inherited destroy;
end;

procedure TColorMenu.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
Var Item: TMenuItem;
begin
Item:= FMenu.FindItem(Index, fkCommand);
InflateRect(Rect, 0, -1);
case Index of
0 : Canvas.Brush.Color:= clBlack;
1 : Canvas.Brush.Color:= clMaroon;
2 : Canvas.Brush.Color:= clGreen;
3 : Canvas.Brush.Color:= clOlive;
4 : Canvas.Brush.Color:= clNavy;
5 : Canvas.Brush.Color:= clPurple;
6 : Canvas.Brush.Color:= clTeal;
7 : Canvas.Brush.Color:= clGray;
8 : Canvas.Brush.Color:= clSilver;
9 : Canvas.Brush.Color:= clRed;
10 : Canvas.Brush.Color:= clLime;
11 : Canvas.Brush.Color:= clBlue;
12 : Canvas.Brush.Color:= clFuchsia;
13 : Canvas.Brush.Color:= clAqua;
14 : Canvas.Brush.Color:= clWhite;
end;
Canvas.FillRect(Rect);
Canvas.Pen.Color:= clBtnShadow;
Canvas.MoveTo(Rect.Left, Rect.Bottom);
Canvas.LineTo(Rect.Left, Rect.Top);
Canvas.LineTo(Rect.Right, Rect.Top);
Canvas.Pen.Color:= clBtnHighLight;
Canvas.MoveTo(Rect.Right, Rect.Top);
Canvas.LineTo(Rect.Right, Rect.Bottom);
Canvas.LineTo(Rect.Left, Rect.Bottom);
if (Item.Checked) then begin
Canvas.Pen.Width:= 3;
Canvas.Pen.Color:= clBlack;
Canvas.MoveTo(Rect.Left+2, Rect.Top+2);
Canvas.LineTo(Rect.Right-2, Rect.Bottom - 2);
Canvas.MoveTo(Rect.Left+2, Rect.Bottom-2);
Canvas.LineTo(Rect.Right-2, Rect.Top+2);
Canvas.Pen.Width:= 1;
Canvas.Pen.Color:= Canvas.Brush.Color;
Canvas.Brush.Style:= bsClear;
Canvas.Rectangle(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom-1);
end;
end;

procedure Register;
begin
RegisterComponents('Exemples', [TMenuExtender]);
RegisterComponents('Exemples', [TColorMenu]);
end;
end.

一个现成的资料，你慢慢看吧

我们这里 qq 的端口被封了 只能上网 没办法
e-mail:chshanghai@sina.com
chshanghai@sohu.com

wk_knife:您好,我大致看了一下您担供的代码,下班后我会再仔细看,不过我有两个问题,
1.这个代码不能在DELPHI6上通过,
2.这段代码,是搜索MENU控件,但我的想法是建一个独立的MENU控件,而不是依靠其已提供的
控件,然后再搜索其句柄进行重绘.

1、这个很正常，经常有这种事，包括vc,vb，每次工具的升级都会导致某些程序不能直接应用
2、这个问题有两种情况：一 是如果MainMENU（比较特殊）不建立好，就无法对其重绘，这个控件是解决的
唯一思路；二 是如果可以自己重绘，既然别的控件都可以得到自己的句柄，那么自己得到自己就更
没有问题了，你说呢？

这个控件是我从我的收藏里拉出来的，我自己并没有认真看，无法细说，相信你可以自己解决。

我要下班了,明天再来,如果晚上有空我也会来的,

众位湖前辈：今天我再试了一次拷贝VCL中的MENUS.PAS 然后更名另存，再把所有的类，
用整个关键词的方式替换。另一个名字，编译通过（会有一句不通过，就//）然后注册成功
但ITEMS属性不打开方式不对，不是...这样三个小点点而是前面一个’十‘号，其它都有对
但这一点不对，无法进行菜单设计，？！！！！请大家指教。

因为它需要一个专门的对象设计器，就象Delphi中的菜单设计窗体

多人接受答案了。