Skip to content

Commit a22efca

Browse files
hunschehunsche
committed
Added Local Menu Item
1 parent 04d3424 commit a22efca

File tree

5 files changed

+833
-0
lines changed

5 files changed

+833
-0
lines changed

‎DelphiDocker.LocalMenuItem.pas‎

Lines changed: 194 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,194 @@
1+
unit DelphiDocker.LocalMenuItem;
2+
3+
interface
4+
5+
uses
6+
ToolsAPI, Vcl.ActnList, System.Classes, Dialogs;
7+
8+
type
9+
TNotifierLocalMenuItem = class(TNotifierObject, IOTANotifier, IOTAProjectMenuItemCreatorNotifier)
10+
public
11+
function IsProject(const AIdent: string): Boolean;
12+
procedure AddMenu(const AProject: IOTAProject; const AIdentList: TStrings;
13+
const AProjectManagerMenuList: IInterfaceList; AIsMultiSelect: Boolean);
14+
end;
15+
16+
TLocalMenuItem = class(TNotifierObject, IOTALocalMenu, IOTAProjectManagerMenu)
17+
private
18+
FCaption: string;
19+
FChecked: Boolean;
20+
FEnabled: Boolean;
21+
FHelpContext: Integer;
22+
FName: string;
23+
FParent: string;
24+
FPosition: Integer;
25+
FVerb: string;
26+
FOnExecute: TNotifyEvent;
27+
public
28+
function GetCaption: string;
29+
function GetChecked: Boolean;
30+
function GetEnabled: Boolean;
31+
function GetHelpContext: Integer;
32+
function GetName: string;
33+
function GetParent: string;
34+
function GetPosition: Integer;
35+
function GetVerb: string;
36+
procedure SetCaption(const Value: string);
37+
procedure SetChecked(Value: Boolean);
38+
procedure SetEnabled(Value: Boolean);
39+
procedure SetHelpContext(Value: Integer);
40+
procedure SetName(const Value: string);
41+
procedure SetParent(const Value: string);
42+
procedure SetPosition(Value: Integer);
43+
procedure SetVerb(const Value: string);
44+
property Caption: string read GetCaption write SetCaption;
45+
property Checked: Boolean read GetChecked write SetChecked;
46+
property Enabled: Boolean read GetEnabled write SetEnabled;
47+
property HelpContext: Integer read GetHelpContext write SetHelpContext;
48+
property Name: string read GetName write SetName;
49+
property Parent: string read GetParent write SetParent;
50+
property Position: Integer read GetPosition write SetPosition;
51+
property Verb: string read GetVerb write SetVerb;
52+
property OnExecute: TNotifyEvent read FOnExecute write FOnExecute;
53+
function GetIsMultiSelectable: Boolean;
54+
procedure SetIsMultiSelectable(Value: Boolean);
55+
procedure Execute(const MenuContextList: IInterfaceList); overload;
56+
function PreExecute(const MenuContextList: IInterfaceList): Boolean;
57+
function PostExecute(const MenuContextList: IInterfaceList): Boolean;
58+
property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
59+
constructor Create;
60+
end;
61+
62+
implementation
63+
64+
constructor TLocalMenuItem.Create;
65+
begin
66+
FCaption := 'Run With Docker';
67+
FEnabled := True;
68+
FPosition := pmmpRunNoDebug + 10;
69+
end;
70+
71+
procedure TLocalMenuItem.Execute(const MenuContextList: IInterfaceList);
72+
begin
73+
ShowMessage('teste');
74+
end;
75+
76+
function TLocalMenuItem.GetCaption: string;
77+
begin
78+
Result := FCaption;
79+
end;
80+
81+
function TLocalMenuItem.GetChecked: Boolean;
82+
begin
83+
Result := FChecked;
84+
end;
85+
86+
function TLocalMenuItem.GetEnabled: Boolean;
87+
begin
88+
Result := FEnabled;
89+
end;
90+
91+
function TLocalMenuItem.GetHelpContext: Integer;
92+
begin
93+
Result := FHelpContext;
94+
end;
95+
96+
function TLocalMenuItem.GetIsMultiSelectable: Boolean;
97+
begin
98+
99+
end;
100+
101+
function TLocalMenuItem.GetName: string;
102+
begin
103+
Result := FName;
104+
end;
105+
106+
function TLocalMenuItem.GetParent: string;
107+
begin
108+
Result := FParent;
109+
end;
110+
111+
function TLocalMenuItem.GetPosition: Integer;
112+
begin
113+
Result := FPosition;
114+
end;
115+
116+
function TLocalMenuItem.GetVerb: string;
117+
begin
118+
Result := FVerb;
119+
end;
120+
121+
function TLocalMenuItem.PostExecute(const MenuContextList: IInterfaceList): Boolean;
122+
begin
123+
124+
end;
125+
126+
function TLocalMenuItem.PreExecute(const MenuContextList: IInterfaceList): Boolean;
127+
begin
128+
129+
end;
130+
131+
procedure TLocalMenuItem.SetCaption(const Value: string);
132+
begin
133+
FCaption := Value;
134+
end;
135+
136+
procedure TLocalMenuItem.SetChecked(Value: Boolean);
137+
begin
138+
FChecked := Value;
139+
end;
140+
141+
procedure TLocalMenuItem.SetEnabled(Value: Boolean);
142+
begin
143+
FEnabled := Value;
144+
end;
145+
146+
procedure TLocalMenuItem.SetHelpContext(Value: Integer);
147+
begin
148+
FHelpContext := Value;
149+
end;
150+
151+
procedure TLocalMenuItem.SetIsMultiSelectable(Value: Boolean);
152+
begin
153+
154+
end;
155+
156+
procedure TLocalMenuItem.SetName(const Value: string);
157+
begin
158+
FName := Value;
159+
end;
160+
161+
procedure TLocalMenuItem.SetParent(const Value: string);
162+
begin
163+
FParent := Value;
164+
end;
165+
166+
procedure TLocalMenuItem.SetPosition(Value: Integer);
167+
begin
168+
FPosition := Value;
169+
end;
170+
171+
procedure TLocalMenuItem.SetVerb(const Value: string);
172+
begin
173+
FVerb := Value;
174+
end;
175+
176+
{ TNotifierLocalMenu }
177+
178+
procedure TNotifierLocalMenuItem.AddMenu(const AProject: IOTAProject; const AIdentList: TStrings;
179+
const AProjectManagerMenuList: IInterfaceList; AIsMultiSelect: Boolean);
180+
begin
181+
if IsProject(AProject.ApplicationType) and (not AIsMultiSelect) and Assigned(AProject) and
182+
(AIdentList.IndexOf(sProjectContainer) <> -1) and Assigned(AProjectManagerMenuList) then
183+
begin
184+
AProjectManagerMenuList.Add(TLocalMenuItem.Create);
185+
end;
186+
end;
187+
188+
function TNotifierLocalMenuItem.IsProject(const AIdent: string): Boolean;
189+
begin
190+
Result := (AIdent = sApplication) or (AIdent = sConsole) or (AIdent = sPackage);
191+
end;
192+
193+
end.
194+

‎DelphiDocker.Register.pas‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
unit DelphiDocker.Register;
2+
3+
interface
4+
5+
uses
6+
ToolsAPI, Vcl.ComCtrls, DelphiDocker.LocalMenuItem;
7+
8+
procedure Register;
9+
10+
implementation
11+
12+
procedure AddLocalMenuDocker;
13+
var
14+
LNotifierMenuIndex: Integer;
15+
begin
16+
LNotifierMenuIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuItemCreatorNotifier
17+
(TNotifierLocalMenuItem.Create);
18+
end;
19+
20+
procedure AddToolBarDocker;
21+
// var
22+
// LToolButton: TToolButton;
23+
// LToolBarItem: TToolBar;
24+
begin
25+
// LToolBarItem := (BorlandIDEServices as INTAServices).ToolBar[sDebugToolBar];
26+
// LToolButton := TToolButton.Create(LToolBarItem);
27+
// LToolButton.Caption := 'Run With Docker';
28+
// LToolButton.
29+
// LToolButton.Parent := LToolBarItem;
30+
end;
31+
32+
procedure Register;
33+
begin
34+
AddLocalMenuDocker;
35+
AddToolBarDocker;
36+
end;
37+
38+
end.

‎delphi_docker.dpk‎

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
package delphi_docker;
2+
3+
{$R *.res}
4+
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
5+
{$ALIGN 8}
6+
{$ASSERTIONS ON}
7+
{$BOOLEVAL OFF}
8+
{$DEBUGINFO OFF}
9+
{$EXTENDEDSYNTAX ON}
10+
{$IMPORTEDDATA ON}
11+
{$IOCHECKS ON}
12+
{$LOCALSYMBOLS ON}
13+
{$LONGSTRINGS ON}
14+
{$OPENSTRINGS ON}
15+
{$OPTIMIZATION OFF}
16+
{$OVERFLOWCHECKS OFF}
17+
{$RANGECHECKS OFF}
18+
{$REFERENCEINFO ON}
19+
{$SAFEDIVIDE OFF}
20+
{$STACKFRAMES ON}
21+
{$TYPEDADDRESS OFF}
22+
{$VARSTRINGCHECKS ON}
23+
{$WRITEABLECONST OFF}
24+
{$MINENUMSIZE 1}
25+
{$IMAGEBASE $400000}
26+
{$DEFINE DEBUG}
27+
{$ENDIF IMPLICITBUILDING}
28+
{$DESIGNONLY}
29+
{$IMPLICITBUILD ON}
30+
31+
requires
32+
rtl,
33+
designide;
34+
35+
contains
36+
DelphiDocker.Register in 'DelphiDocker.Register.pas',
37+
DelphiDocker.LocalMenuItem in 'DelphiDocker.LocalMenuItem.pas';
38+
39+
end.

0 commit comments

Comments
 (0)