تركيب دو PopUpMenu با تمام SubMenuهاي آن در يك PopUpMenu ديگر

[SayeyeZohor]

با سلام
من يك popup به صورت Default در يك فرم جدا دارم كه مي خوام با PopupMenu فرم جاري من تركيب بشند و در يك Popup ديگر (به نام EndPopup) در فرم جاري من ذخيره بشند بعدش به فرم جاري اختصاص داده شند
ضمناً چون اين كار در FormShow برنامه اتفاق مي افته نبايد دوباره اضافه بشند يعني يك جورايي چك بشه كه به فرض مثال كامپوننت N1 از نوع TMenuItem وجود دارد يا خير؟
من با Findcomponent چك مي كردم ولي چون دايناميك هست نمي شناخت

نمونه كدي كه نوشتم با Sample اينجاست
:لبخندساده:


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ImgList, Menus, ExtCtrls, Buttons, XPMan, jpeg;

type
TForm1 = class(TForm)
PopupForm: TPopupMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
SZSGPopup: TPopupMenu;
_NRecord_: TMenuItem;
_ERecord_: TMenuItem;
_DRecord_: TMenuItem;
_Line1_: TMenuItem;
_Line2_: TMenuItem;
_FindRecord_: TMenuItem;
_Line3_: TMenuItem;
_SViewGrid_: TMenuItem;
_SViewGrid_Def_: TMenuItem;
_SViewGrid_Custom_: TMenuItem;
_Line5_: TMenuItem;
_SViewGrid_Save_: TMenuItem;
_FViewGrid_: TMenuItem;
_FViewGrid_Def: TMenuItem;
_FViewGrid_Custom_: TMenuItem;
_FViewGrid_New_: TMenuItem;
_Line6_: TMenuItem;
_FViewGrid_Save_: TMenuItem;
_Line4_: TMenuItem;
_BackForm_: TMenuItem;
il2: TImageList;
N12: TMenuItem;
Panel1: TPanel;
Button3: TButton;
Button4: TButton;
Button1: TButton;
Button2: TButton;
Button5: TButton;
Button6: TButton;
XPManifest1: TXPManifest;
Button7: TButton;
Panel2: TPanel;
Image1: TImage;
Label1: TLabel;
PROCEDURE PopupOnButton(Sender: TObject; PopUpName: TPopupMenu);
PROCEDURE CreateEndPopupMenu(Sender: TObject);
PROCEDURE PopupClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

PROCEDURE TForm1.PopupOnButton(Sender: TObject; PopUpName: TPopupMenu);
var
pt : TPoint;
begin
with Sender as TControl do
begin
pt := Parent.ClientToScreen(Point(Left+Width, Top+Height));
PopUpName.Popup(pt.X,pt.Y);
end;
end;

PROCEDURE TForm1.CreateEndPopupMenu(Sender: TObject); // تركيبي PopUpMenu ساخت ...
var
EndPopup: TPopupMenu;
MyComp: TComponent;
BEGIN
MyComp := Self.FindComponent('EndPopupMenu');
IF Assigned(MyComp) THEN Exit; // قبلاً ساخته شده است ...

EndPopup := TPopupMenu.Create(Self);
WITH EndPopup DO
BEGIN
Alignment := paLeft;
AutoHotkeys := maManual;
AutoLineReduction := maManual;
AutoPopup := True;
BiDiMode := bdRightToLeft;
Name := 'EndPopupMenu';
Images := il2;
END;
Self.PopupMenu := EndPopup;
END;

PROCEDURE TForm1.PopupClick(Sender: TObject);
BEGIN
with TMenuItem(Sender) do ShowMessage('Caption = '+Caption+' - '+'Name = '+Name);

(Sender as tMenuItem).Checked := NOT (Sender as tMenuItem).Checked;

// with Sender as TMenuItem do
// begin
// case Tag of
// 0: ShowMessage('first item clicked');
// 1: ShowMessage('second item clicked');
// 2: ShowMessage('third item clicked');
// 3: ShowMessage('fourth item clicked');
// end;
// end;
END;


procedure TForm1.Button3Click(Sender: TObject);
begin
PopupOnButton(Sender, PopupForm);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
I, H, J, Index: Integer;
NPopUp2: TPopupMenu;
begin
NPopUp2 := PopupForm;
H := 0;
for I := 0 to NPopUp2.Items.Count - 1 do
Begin
ShowMessage('Items['+IntToStr(I)+'] = '+NPopUp2.Items[I].Caption);
if NPopUp2.Items[I].Count > 0 then
for J := 0 to NPopUp2.Items[I].Count - 1 do
ShowMessage('Items['+IntToStr(I)+'].Items['+IntToStr(J)+'] = '+'< Sub > -- '+NPopUp2.Items[I].Items[J].Caption);
End;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
PopupOnButton(Sender, SZSGPopup);
end;

procedure TForm1.Button5Click(Sender: TObject);
var
I, H, J, Index: Integer;
NPopUp1: TPopupMenu;
begin
NPopUp1 := SZSGPopup;
H := 0;
for I := 0 to NPopUp1.Items.Count - 1 do
Begin
ShowMessage('Items['+IntToStr(I)+'] = '+NPopUp1.Items[I].Caption);
if NPopUp1.Items[I].Count > 0 then
for J := 0 to NPopUp1.Items[I].Count - 1 do
ShowMessage('Items['+IntToStr(I)+'].Items['+IntToStr(J)+'] = '+'< Sub > -- '+NPopUp1.Items[I].Items[J].Caption);
End;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
I, J, H, Index: Integer;
NPopUp1, NPopUp2: TPopupMenu;
NewItem: TMenuItem;

EndPopup: TPopupMenu;
Item, SubItem: TMenuItem;
begin
// EndPopupMenu در (SZSGPopup) اول Popup مرحله اول انتقال منوهاي ...
//ها انتقال داده نشده اند Submenu : توجه ...
H := 0;
NPopUp1 := SZSGPopup;
NPopUp2 := Self.PopupMenu;
Index := NPopUp1.Items.Count;
For I := 0 to Index - 1 do
BEGIN
NewItem := TMenuItem.Create(NPopUp1);
WITH NewItem DO
BEGIN
Name := '_'+NPopUp1.Items[I].Name+'_';
Caption := NPopUp1.Items[I].Caption;
Tag := Index;
OnClick := NPopUp1.Items[I].OnClick;
RadioItem := True;
ImageIndex := NPopUp1.Items[I].ImageIndex;
ShortCut := NPopUp1.Items[I].ShortCut;
AutoCheck := NPopUp1.Items[I].AutoCheck;
END;
NPopUp2.Items.Insert(H, NewItem);
Inc(H);
//ShowMessage('Sub '+NPopUp1.Items[I].Items[J].Caption);
END;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
I, J, H, Index: Integer;
NPopUp1, NPopUp2: TPopupMenu;
NewItem: TMenuItem;

EndPopup: TPopupMenu;
Item, SubItem: TMenuItem;
begin
// EndPopupMenu در (PopupForm) دوم Popup مرحله دوم انتقال منوهاي ...
//ها انتقال داده نشده اند Submenu : توجه ...
H := 4;
NPopUp1 := PopupForm;
NPopUp2 := Self.PopupMenu;
Index := NPopUp1.Items.Count;
For I := 0 to Index - 1 do
BEGIN
NewItem := TMenuItem.Create(NPopUp1);
WITH NewItem DO
BEGIN
Name := '_'+NPopUp1.Items[I].Name+'_';
Caption := NPopUp1.Items[I].Caption;
Tag := Index;
OnClick := NPopUp1.Items[I].OnClick;
RadioItem := True;
ImageIndex := NPopUp1.Items[I].ImageIndex;
ShortCut := NPopUp1.Items[I].ShortCut;
AutoCheck := NPopUp1.Items[I].AutoCheck;
END;
NPopUp2.Items.Insert(H, NewItem);
Inc(H);
//ShowMessage('Sub '+NPopUp1.Items[I].Items[J].Caption);
END;
end;


procedure TForm1.Button6Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CreateEndPopupMenu(Self);
end;

end.


اينم سورسش كه نوشتم
خيلي مهمه برام
ممنون
http://s1.picofile.com/file/7275713973/Create_MixPopUpMenu.rar.html

[SayeyeZohor]

هيچ كس نيس؟
بابا اساتيد كجاييد؟

[SAASTN]

خوب؟ مشکل کجاست؟ شما یه EndPopup داری که همیشه آیتم هاش رو خودت میسازی، پس بدون نگرانی همون اول میزنی همه آیتم هایی که قبلا توش ریخته شده رو آزاد می کنی، بعد دوتا حلقه میزاری روی دوتا Popupی که قراره بریزی تو EndPopup و دونه دونه آیتم هاشونو تو EndPopup اضافه می کنی. یعنی یه TMenuItem میسازی، مشخصاتشو با Item[I]ام Popup ورودی یکی می کنی و این آیتم جدید رو تو EndPopup اضافه می کنی، حالا این متد رو می تونی بصورت بازگشتی بنویسی که SubMenu ها رو هم Add کنه. اون FindComponent هم نفهمیدم برا چی لازم داری. و در ضمن وقتی کل پروژت رو کپی می کنی اینجا کسی حال( یا حس، وقت، حوصله، اعصاب و ...) نداره بره بگرده توش مشکل رو پیدا کنه(به عنوان مثال خود بنده:لبخند:)، شما خودت اون بخش مورد نظرت رو پیدا کن و همونو اینجا بذار.

[SayeyeZohor]

SAASTN جان جينگولي سلام
بابا يك بار مي گي كدتو تو تگ بذار و كامل نيس
حالا ...
عزيز من PopUp آخري رو خودم مي سازم چون اين رويداد در FormShow اتفاق مي افته و PopUp اولي تو هر فرمي فرق داره لازمه كه FindComponent كنم كه EndPopup من دوباره ايجاد نشه
سوال :
نمي تونم SubMenu ها رو اضافه كنم


حالا این متد رو می تونی بصورت بازگشتی بنویسی که SubMenu ها رو هم Add کنه.

چطوري؟

[SAASTN]

بابا يك بار مي گي كدتو تو تگ بذار و كامل نيس
خوب کد کامل کدیه که مشکل رو نشون بده، نه اینکه تعداد خطش زیاد باشه، دیگه این.کلیک و اون.کلیک که ربطی به مشکل نداره. حالا انقدر دعوا می کنیم تا اخلاق هم بیاد دستمون ...

چطوري؟
procedure AssignMenuItem(Source, Dest: TMenuItem);
begin
Dest.Action := Source.Action;
Dest.AutoCheck := Source.AutoCheck;
Dest.AutoHotkeys := Source.AutoHotkeys;
Dest.AutoLineReduction := Source.AutoLineReduction;
Dest.Bitmap := Source.Bitmap;
Dest.Break := Source.Break;
Dest.Caption := Source.Caption;
Dest.Checked := Source.Checked;
Dest.SubMenuImages := Source.SubMenuImages;
Dest.Default := Source.Default;
Dest.Enabled := Source.Enabled;
Dest.GroupIndex := Source.GroupIndex;
Dest.HelpContext := Source.HelpContext;
Dest.Hint := Source.Hint;
Dest.ImageIndex := Source.ImageIndex;
Dest.RadioItem := Source.RadioItem;
Dest.ShortCut := Source.ShortCut;
Dest.Visible := Source.Visible;
Dest.OnClick := Source.OnClick;
Dest.OnDrawItem := Source.OnDrawItem;
Dest.OnAdvancedDrawItem := Source.OnAdvancedDrawItem;
Dest.OnMeasureItem := Source.OnMeasureItem;
end;

procedure AddSubMenus(Source, Dest: TMenuItem);
var
I: Integer;
NewItem: TMenuItem;
begin
for I := 0 to Source.Count - 1 do
begin
NewItem := TMenuItem.Create(Source.Owner);
AssignMenuItem(Source.Items[I], NewItem);
Dest.Add(NewItem);
AddSubMenus(Source.Items[I], NewItem);
end;
end;

procedure CombinePopupMenus(Source1, Source2, Dest: TPopupMenu);
var
I: Integer;
begin
for I := 0 to Dest.Items.Count - 1 do
Dest.Items[I].Free;
Dest.Items.Clear;
AddSubMenus(Source1.Items, Dest.Items);
AddSubMenus(Source2.Items, Dest.Items);
end;

// طریقه استفاده
CombinePopupMenus(PopupMenu1, PopupMenu2, PopupMenu3);