mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-04 20:58:32 +02:00
ide: add drop down build mode menu for options button in project inspector.
git-svn-id: trunk@53699 -
This commit is contained in:
ondrej
parent
b5255eebaa
commit
0b5c0aac35
16
ide/main.pp
16
ide/main.pp
@ -3833,7 +3833,8 @@ procedure TMainIDE.UpdateProjectCommands(Sender: TObject);
|
||||
var
|
||||
ASrcEdit: TSourceEditor;
|
||||
AUnitInfo: TUnitInfo;
|
||||
xCmd: TIDECommand;
|
||||
ACmd: TIDECommand;
|
||||
ABuildHint: string;
|
||||
begin
|
||||
GetCurrentUnit(ASrcEdit,AUnitInfo);
|
||||
if not UpdateProjectCommandsStamp.Changed(AUnitInfo) then
|
||||
@ -3842,14 +3843,17 @@ begin
|
||||
IDECommandList.FindIDECommand(ecAddCurUnitToProj).Enabled:=Assigned(AUnitInfo) and not AUnitInfo.IsPartOfProject;
|
||||
IDECommandList.FindIDECommand(ecBuildManyModes).Enabled:=(Project1<>nil) and (Project1.BuildModes.Count>1);
|
||||
|
||||
xCmd := IDECommandList.FindIDECommand(ecProjectChangeBuildMode);
|
||||
ACmd := IDECommandList.FindIDECommand(ecProjectChangeBuildMode);
|
||||
if Assigned(Project1) then
|
||||
xCmd.Hint :=
|
||||
Trim(lisChangeBuildMode + ' ' + KeyValuesToCaptionStr(xCmd.ShortcutA, xCmd.ShortcutB, '(')) + sLineBreak +
|
||||
ABuildHint :=
|
||||
Trim(lisChangeBuildMode + ' ' + KeyValuesToCaptionStr(ACmd.ShortcutA, ACmd.ShortcutB, '(')) + sLineBreak +
|
||||
Format('[%s]', [Project1.ActiveBuildMode.GetCaption])
|
||||
else
|
||||
xCmd.Hint :=
|
||||
Trim(lisChangeBuildMode + ' ' + KeyValuesToCaptionStr(xCmd.ShortcutA, xCmd.ShortcutB, '('));
|
||||
ABuildHint :=
|
||||
Trim(lisChangeBuildMode + ' ' + KeyValuesToCaptionStr(ACmd.ShortcutA, ACmd.ShortcutB, '('));
|
||||
|
||||
ACmd.Hint := ABuildHint;
|
||||
ProjInspector.OptionsBitBtn.Hint := ABuildHint;
|
||||
end;
|
||||
|
||||
procedure TMainIDE.UpdatePackageCommands(Sender: TObject);
|
||||
|
||||
137
ide/mainbase.pas
137
ide/mainbase.pas
@ -207,9 +207,17 @@ type
|
||||
{ TSetBuildModeToolButton }
|
||||
|
||||
TSetBuildModeToolButton = class(TIDEToolButton)
|
||||
private
|
||||
procedure RefreshMenu(Sender: TObject);
|
||||
procedure mnuSetBuildModeClick(Sender: TObject);
|
||||
public type
|
||||
TBuildModeMenuItem = class(TMenuItem)
|
||||
public
|
||||
BuildModeIndex: Integer;
|
||||
procedure Click; override;
|
||||
end;
|
||||
|
||||
TBuildModeMenu = class(TPopupMenu)
|
||||
protected
|
||||
procedure DoPopup(Sender: TObject); override;
|
||||
end;
|
||||
public
|
||||
procedure DoOnAdded; override;
|
||||
end;
|
||||
@ -296,6 +304,66 @@ begin
|
||||
Result := TMainIDEBase(MainIDEInterface)
|
||||
end;
|
||||
|
||||
{ TSetBuildModeToolButton.TBuildModeMenu }
|
||||
|
||||
procedure TSetBuildModeToolButton.TBuildModeMenu.DoPopup(Sender: TObject);
|
||||
var
|
||||
CurIndex: Integer;
|
||||
i: Integer;
|
||||
|
||||
procedure AddMode(BuildModeIndex: Integer; CurMode: TProjectBuildMode);
|
||||
var
|
||||
AMenuItem: TBuildModeMenuItem;
|
||||
begin
|
||||
if Items.Count > CurIndex then
|
||||
AMenuItem := Items[CurIndex] as TBuildModeMenuItem
|
||||
else
|
||||
begin
|
||||
AMenuItem := TBuildModeMenuItem.Create(DropdownMenu);
|
||||
AMenuItem.Name := Name + 'Mode' + IntToStr(CurIndex);
|
||||
Items.Add(AMenuItem);
|
||||
end;
|
||||
AMenuItem.BuildModeIndex := BuildModeIndex;
|
||||
AMenuItem.Caption := CurMode.GetCaption;
|
||||
AMenuItem.Checked := (Project1<>nil) and (Project1.ActiveBuildMode=CurMode);
|
||||
AMenuItem.ShowAlwaysCheckable:=true;
|
||||
inc(CurIndex);
|
||||
end;
|
||||
|
||||
begin
|
||||
// fill the PopupMenu
|
||||
CurIndex := 0;
|
||||
if Project1<>nil then
|
||||
for i:=0 to Project1.BuildModes.Count-1 do
|
||||
AddMode(i, Project1.BuildModes[i]);
|
||||
// remove unused menuitems
|
||||
while Items.Count > CurIndex do
|
||||
Items[Items.Count - 1].Free;
|
||||
|
||||
inherited DoPopup(Sender);
|
||||
end;
|
||||
|
||||
{ TSetBuildModeToolButton.TBuildModeMenuItem }
|
||||
|
||||
procedure TSetBuildModeToolButton.TBuildModeMenuItem.Click;
|
||||
var
|
||||
NewMode: TProjectBuildMode;
|
||||
begin
|
||||
inherited Click;
|
||||
|
||||
NewMode := Project1.BuildModes[BuildModeIndex];
|
||||
if NewMode = Project1.ActiveBuildMode then exit;
|
||||
if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
|
||||
IDEMessageDialog('Error','You can not change the build mode while compiling.',
|
||||
mtError,[mbOk]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Project1.ActiveBuildMode := NewMode;
|
||||
MainBuildBoss.SetBuildTargetProject1(false);
|
||||
MainIDE.UpdateCaption;
|
||||
end;
|
||||
|
||||
{ TNewFormUnitToolButton }
|
||||
|
||||
procedure TNewFormUnitToolButton.DoOnAdded;
|
||||
@ -502,71 +570,10 @@ procedure TSetBuildModeToolButton.DoOnAdded;
|
||||
begin
|
||||
inherited DoOnAdded;
|
||||
|
||||
DropdownMenu := TPopupMenu.Create(Self);
|
||||
DropdownMenu.OnPopup := @RefreshMenu;
|
||||
DropdownMenu := TBuildModeMenu.Create(Self);
|
||||
Style := tbsDropDown;
|
||||
end;
|
||||
|
||||
procedure TSetBuildModeToolButton.mnuSetBuildModeClick(Sender: TObject);
|
||||
var
|
||||
TheMenuItem: TMenuItem;
|
||||
TheIndex: LongInt;
|
||||
NewMode: TProjectBuildMode;
|
||||
begin
|
||||
TheMenuItem := (Sender as TMenuItem);
|
||||
if TheMenuItem.Caption = '-' then exit;
|
||||
TheIndex := TheMenuItem.MenuIndex;
|
||||
if (TheIndex < 0) or (TheIndex >= Project1.BuildModes.Count) then exit;
|
||||
NewMode := Project1.BuildModes[TheIndex];
|
||||
if NewMode = Project1.ActiveBuildMode then exit;
|
||||
if not (MainIDE.ToolStatus in [itNone,itDebugger]) then begin
|
||||
IDEMessageDialog('Error','You can not change the build mode while compiling.',
|
||||
mtError,[mbOk]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Project1.ActiveBuildMode := NewMode;
|
||||
MainBuildBoss.SetBuildTargetProject1(false);
|
||||
MainIDE.UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TSetBuildModeToolButton.RefreshMenu(Sender: TObject);
|
||||
var
|
||||
aMenu: TPopupMenu;
|
||||
CurIndex: Integer;
|
||||
i: Integer;
|
||||
|
||||
procedure AddMode(CurMode: TProjectBuildMode);
|
||||
var
|
||||
AMenuItem: TMenuItem;
|
||||
begin
|
||||
if aMenu.Items.Count > CurIndex then
|
||||
AMenuItem := aMenu.Items[CurIndex]
|
||||
else
|
||||
begin
|
||||
AMenuItem := TMenuItem.Create(DropdownMenu);
|
||||
AMenuItem.Name := aMenu.Name + 'Mode' + IntToStr(CurIndex);
|
||||
AMenuItem.OnClick := @mnuSetBuildModeClick;
|
||||
aMenu.Items.Add(AMenuItem);
|
||||
end;
|
||||
AMenuItem.Caption := CurMode.GetCaption;
|
||||
AMenuItem.Checked := (Project1<>nil) and (Project1.ActiveBuildMode=CurMode);
|
||||
AMenuItem.ShowAlwaysCheckable:=true;
|
||||
inc(CurIndex);
|
||||
end;
|
||||
|
||||
begin
|
||||
// fill the PopupMenu:
|
||||
CurIndex := 0;
|
||||
aMenu := DropdownMenu;
|
||||
if Project1<>nil then
|
||||
for i:=0 to Project1.BuildModes.Count-1 do
|
||||
AddMode(Project1.BuildModes[i]);
|
||||
// remove unused menuitems
|
||||
while aMenu.Items.Count > CurIndex do
|
||||
aMenu.Items[aMenu.Items.Count - 1].Free;
|
||||
end;
|
||||
|
||||
{ TJumpToSectionToolButton }
|
||||
|
||||
procedure TJumpToSectionToolButton.DoOnAdded;
|
||||
|
||||
@ -64,7 +64,7 @@ uses
|
||||
// IDE
|
||||
LazarusIDEStrConsts, IDEProcs, DialogProcs, IDEOptionDefs, EnvironmentOpts,
|
||||
PackageDefs, Project, PackageEditor, AddToProjectDlg, AddPkgDependencyDlg,
|
||||
InputHistory, ProjPackChecks;
|
||||
InputHistory, MainBase, ProjPackChecks;
|
||||
|
||||
type
|
||||
TOnAddUnitToProject =
|
||||
@ -1027,6 +1027,8 @@ begin
|
||||
RemoveBitBtn := CreateToolButton('RemoveBitBtn', lisRemove, lisPckEditRemoveSelectedItem, 'laz_delete', @RemoveBitBtnClick);
|
||||
CreateDivider;
|
||||
OptionsBitBtn := CreateToolButton('OptionsBitBtn', lisOptions, lisPckEditEditGeneralOptions, 'menu_environment_options', @OptionsBitBtnClick);
|
||||
OptionsBitBtn.DropdownMenu := TSetBuildModeToolButton.TBuildModeMenu.Create(Self);
|
||||
OptionsBitBtn.Style := tbsDropDown;
|
||||
HelpBitBtn := CreateToolButton('HelpBitBtn', GetButtonCaption(idButtonHelp), lisMenuOnlineHelp, 'menu_help', @HelpBitBtnClick);
|
||||
|
||||
AddBitBtn.DropdownMenu:=AddPopupMenu;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user