1 unit project_application_options;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, Math,
9 // LazUtils
10 FileUtil,
11 // LCL
12 LCLProc, LCLType, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Buttons,
13 ComCtrls, ExtDlgs,
14 // LazControls
15 DividerBevel,
16 // IdeIntf
17 IDEOptionsIntf, IDEOptEditorIntf, LazIDEIntf, IDEImagesIntf, IDEDialogs,
18 // IDE
19 LazarusIDEStrConsts, Project, ProjectIcon, CompilerOptions,
20 ApplicationBundle, W32Manifest;
21
22 type
23
24 { TProjectApplicationOptionsFrame }
25
26 TProjectApplicationOptionsFrame = class(TAbstractIDEOptionsEditor)
27 AppSettingsGroupBox: TGroupBox;
28 DarwinDividerBevel: TDividerBevel;
29 NameEdit: TEdit;
30 DescriptionEdit: TEdit;
31 NameLabel: TLabel;
32 DescriptionLabel: TLabel;
33 UseLCLScalingCheckBox: TCheckBox;
34 CreateAppBundleButton: TBitBtn;
35 DefaultIconButton: TButton;
36 DpiAwareLabel: TLabel;
37 DpiAwareComboBox: TComboBox;
38 WindowsDividerBevel: TDividerBevel;
39 UIAccessCheckBox: TCheckBox;
40 ExecutionLevelComboBox: TComboBox;
41 ClearIconButton: TBitBtn;
42 IconImage: TImage;
43 IconLabel: TLabel;
44 IconPanel: TPanel;
45 IconTrack: TTrackBar;
46 IconTrackLabel: TLabel;
47 ExecutionLevelLabel: TLabel;
48 LoadIconButton: TBitBtn;
49 OpenPictureDialog1: TOpenPictureDialog;
50 SaveIconButton: TBitBtn;
51 SavePictureDialog1: TSavePictureDialog;
52 TitleEdit: TEdit;
53 TitleLabel: TLabel;
54 UseAppBundleCheckBox: TCheckBox;
55 UseXPManifestCheckBox: TCheckBox;
56 procedure ClearIconButtonClick(Sender: TObject);
57 procedure CreateAppBundleButtonClick(Sender: TObject);
58 procedure DefaultIconButtonClick(Sender: TObject);
59 procedure IconImagePictureChanged(Sender: TObject);
60 procedure IconTrackChange(Sender: TObject);
61 procedure LoadIconButtonClick(Sender: TObject);
62 procedure SaveIconButtonClick(Sender: TObject);
63 procedure UseXPManifestCheckBoxChange(Sender: TObject);
64 private
65 FProject: TProject;
66 fIconChanged: boolean;
67 procedure EnableManifest(aEnable: Boolean);
68 procedure SetIconFromStream(Value: TStream);
GetIconAsStreamnull69 function GetIconAsStream: TStream;
70 public
GetTitlenull71 function GetTitle: string; override;
72 procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override;
73 procedure ReadSettings(AOptions: TAbstractIDEOptions); override;
74 procedure WriteSettings(AOptions: TAbstractIDEOptions); override;
SupportedOptionsClassnull75 class function SupportedOptionsClass: TAbstractIDEOptionsClass; override;
76 end;
77
78 implementation
79
80 {$R *.lfm}
81
82 const
83 ExecutionLevelToCaption: array[TXPManifestExecutionLevel] of PString = (
84 { xmelAsInvoker } @dlgPOAsInvoker,
85 { xmelHighestAvailable } @dlgPOHighestAvailable,
86 { xmelRequireAdministrator } @dlgPORequireAdministrator
87 );
88
CreateProjectApplicationBundlenull89 function CreateProjectApplicationBundle(AProject: TProject): string;
90 // returns target file name
91 var
92 TargetExeName: string;
93 begin
94 Result := '';
95 if AProject.MainUnitInfo = nil then
96 begin
97 IDEMessageDialog(lisCCOErrorCaption, lisThisProjectHasNoMainSourceFile,
98 mtError, [mbCancel]);
99 Exit;
100 end;
101 if AProject.IsVirtual then
102 TargetExeName := LazarusIDE.GetTestBuildDirectory +
103 ExtractFilename(AProject.MainUnitInfo.Filename)
104 else
105 TargetExeName := AProject.CompilerOptions.CreateTargetFilename;
106
107 if not (CreateApplicationBundle(TargetExeName, AProject.GetTitle, True) in
108 [mrOk, mrIgnore]) then
109 begin
110 IDEMessageDialog(lisCCOErrorCaption, Format(
111 lisFailedToCreateApplicationBundleFor, [TargetExeName]), mtError, [
112 mbCancel]);
113 Exit;
114 end;
115 if not (CreateAppBundleSymbolicLink(TargetExeName, True) in [mrOk, mrIgnore]) then
116 begin
117 // no error message needed
118 Exit;
119 end;
120 IDEMessageDialog(lisSuccess, Format(lisTheApplicationBundleWasCreatedFor, [
121 TargetExeName]), mtInformation, [mbOk]);
122 Result := TargetExeName;
123 end;
124
125 { TProjectApplicationOptionsFrame }
126
127 procedure TProjectApplicationOptionsFrame.IconImagePictureChanged(Sender: TObject);
128 var
129 HasIcon: boolean;
130 cx, cy: integer;
131 begin
132 HasIcon := (IconImage.Picture.Graphic <> nil) and
133 (not IconImage.Picture.Graphic.Empty);
134 IconTrack.Enabled := HasIcon;
135 if HasIcon then
136 begin
137 IconTrack.Min := 0;
138 IconTrack.Max := IconImage.Picture.Icon.Count - 1;
139 IconTrack.Position := IconImage.Picture.Icon.Current;
140 IconImage.Picture.Icon.GetSize(cx, cy);
141 IconTrackLabel.Caption :=
142 Format(dlgPOIconDesc, [cx, cy, PIXELFORMAT_BPP[IconImage.Picture.Icon.PixelFormat]]);
143 end
144 else
145 IconTrackLabel.Caption := dlgPOIconDescNone;
146 end;
147
148 procedure TProjectApplicationOptionsFrame.IconTrackChange(Sender: TObject);
149 begin
150 IconImage.Picture.Icon.Current :=
151 Max(0, Min(IconImage.Picture.Icon.Count - 1, IconTrack.Position));
152 end;
153
154 procedure TProjectApplicationOptionsFrame.ClearIconButtonClick(Sender: TObject);
155 begin
156 IconImage.Picture.Clear;
157 fIconChanged:=true;
158 end;
159
160 procedure TProjectApplicationOptionsFrame.CreateAppBundleButtonClick(Sender: TObject);
161 begin
162 CreateProjectApplicationBundle(FProject);
163 end;
164
165 procedure TProjectApplicationOptionsFrame.DefaultIconButtonClick(Sender: TObject);
166 begin
167 IconImage.Picture.Icon.LoadFromResourceName(HInstance, 'MAINICONPROJECT');
168 fIconChanged:=true;
169 end;
170
171 procedure TProjectApplicationOptionsFrame.LoadIconButtonClick(Sender: TObject);
172 begin
173 if OpenPictureDialog1.InitialDir='' then
174 OpenPictureDialog1.InitialDir:=FProject.Directory;
175 if not OpenPictureDialog1.Execute then exit;
176 try
177 IconImage.Picture.LoadFromFile(OpenPictureDialog1.FileName);
178 fIconChanged:=true;
179 except
180 on E: Exception do
181 IDEMessageDialog(lisCCOErrorCaption, E.Message, mtError, [mbOK]);
182 end;
183 end;
184
185 procedure TProjectApplicationOptionsFrame.SaveIconButtonClick(Sender: TObject);
186 begin
187 if SavePictureDialog1.Execute then
188 IconImage.Picture.SaveToFile(SavePictureDialog1.FileName);
189 end;
190
191 procedure TProjectApplicationOptionsFrame.EnableManifest(aEnable: Boolean);
192 begin
193 DpiAwareLabel.Enabled := aEnable;
194 DpiAwareComboBox.Enabled := aEnable;
195 ExecutionLevelLabel.Enabled := aEnable;
196 ExecutionLevelComboBox.Enabled := aEnable;
197 UIAccessCheckBox.Enabled := aEnable;
198 NameEdit.Enabled := aEnable;
199 DescriptionEdit.Enabled := aEnable;
200 end;
201
202 procedure TProjectApplicationOptionsFrame.UseXPManifestCheckBoxChange(Sender: TObject);
203 begin
204 EnableManifest(UseXPManifestCheckBox.Checked);
205 end;
206
207 procedure TProjectApplicationOptionsFrame.SetIconFromStream(Value: TStream);
208 begin
209 IconImage.Picture.Clear;
210 if Value <> nil then
211 try
212 IconImage.Picture.Icon.LoadFromStream(Value);
213 except
214 on E: Exception do
215 IDEMessageDialog(lisCodeToolsDefsReadError, E.Message, mtError, [mbOK]);
216 end;
217 end;
218
GetIconAsStreamnull219 function TProjectApplicationOptionsFrame.GetIconAsStream: TStream;
220 begin
221 Result := nil;
222 if not ((IconImage.Picture.Graphic = nil) or IconImage.Picture.Graphic.Empty) then
223 begin
224 Result := TMemoryStream.Create;
225 IconImage.Picture.Icon.SaveToStream(Result);
226 Result.Position := 0;
227 end;
228 end;
229
TProjectApplicationOptionsFrame.GetTitlenull230 function TProjectApplicationOptionsFrame.GetTitle: string;
231 begin
232 Result := dlgPOApplication;
233 end;
234
235 procedure TProjectApplicationOptionsFrame.Setup(ADialog: TAbstractOptionsEditorDialog);
236 var
237 ExecutionLevel: TXPManifestExecutionLevel;
238 DpiLevel: TXPManifestDpiAware;
239 DpiLevelNames: array[TXPManifestDpiAware] of string;
240 begin
241 AppSettingsGroupBox.Caption := dlgApplicationSettings;
242 TitleLabel.Caption := dlgPOTitle;
243 TitleEdit.Text := '';
244 UseLCLScalingCheckBox.Caption := dlgPOUseLCLScaling;
245 UseLCLScalingCheckBox.Checked := False;
246 UseAppBundleCheckBox.Caption := dlgPOUseAppBundle;
247 UseAppBundleCheckBox.Checked := False;
248
249 // Windows specific, Manifest
250 WindowsDividerBevel.Caption := lisForWindows;
251 UseXPManifestCheckBox.Caption := dlgPOUseManifest;
252
253 DpiAwareLabel.Caption := dlgPODpiAwareness;
254 DpiLevelNames[xmdaFalse] := dlgPODpiAwarenessOff;
255 DpiLevelNames[xmdaTrue] := dlgPODpiAwarenessOn;
256 DpiLevelNames[xmdaPerMonitor] := dlgPODpiAwarenessOldOffNewPerMonitor;
257 DpiLevelNames[xmdaTruePM] := dlgPODpiAwarenessOldOnNewPerMonitor;
258 DpiLevelNames[xmdaPerMonitorV2] := dlgPODpiAwarenessOldOnNewPerMonitorV2;
259
260 ExecutionLevelLabel.Caption := dlgPOExecutionLevel;
261 for ExecutionLevel in TXPManifestExecutionLevel do
262 ExecutionLevelComboBox.Items.Add(ExecutionLevelToCaption[ExecutionLevel]^);
263 for DpiLevel in TXPManifestDpiAware do
264 DpiAwareComboBox.Items.Add(DpiLevelNames[DpiLevel] + ' (' + ManifestDpiAwareValues[DpiLevel] + ')');
265 UIAccessCheckBox.Caption := dlgPOUIAccess;
266 NameLabel.Caption := lisName;
267 DescriptionLabel.Caption := lisCodeHelpDescrTag;
268
269 // Darwin specific, Application Bundle
270 DarwinDividerBevel.Caption := lisForMacOSDarwin;
271 CreateAppBundleButton.Caption := dlgPOCreateAppBundle;
272 IDEImages.AssignImage(CreateAppBundleButton, 'pkg_compile');
273
274 // Icon
275 IconLabel.Caption := dlgPOIcon;
276 LoadIconButton.Caption := dlgPOLoadIcon;
277 DefaultIconButton.Caption := dlgPODefaultIcon;
278 SaveIconButton.Caption := dlgPOSaveIcon;
279 ClearIconButton.Caption := dlgPOClearIcon;
280 LoadIconButton.LoadGlyphFromStock(idButtonOpen);
281 if LoadIconButton.Glyph.Empty then
282 IDEImages.AssignImage(LoadIconButton, 'laz_open');
283 SaveIconButton.LoadGlyphFromStock(idButtonSave);
284 if SaveIconButton.Glyph.Empty then
285 IDEImages.AssignImage(SaveIconButton, 'laz_save');
286 IDEImages.AssignImage(ClearIconButton, 'menu_clean');
287 IconImage.KeepOriginXWhenClipped := True;
288 IconImage.KeepOriginYWhenClipped := True;
289 IconImagePictureChanged(nil);
290 end;
291
292 procedure TProjectApplicationOptionsFrame.ReadSettings(AOptions: TAbstractIDEOptions);
293 var
294 AStream: TStream;
295 begin
296 FProject := (AOptions as TProjectIDEOptions).Project;
297 with FProject do
298 begin
299 TitleEdit.Text := Title;
300 UseLCLScalingCheckBox.Checked := Scaled;
301 UseAppBundleCheckBox.Checked := UseAppBundle;
302 // Manifest
303 with ProjResources.XPManifest do
304 begin
305 UseXPManifestCheckBox.Checked := UseManifest;
306 DpiAwareComboBox.ItemIndex := Ord(DpiAware);
307 ExecutionLevelComboBox.ItemIndex := Ord(ExecutionLevel);
308 UIAccessCheckBox.Checked := UIAccess;
309 NameEdit.Text := TextName;
310 DescriptionEdit.Text := TextDesc;
311 end;
312 EnableManifest(UseXPManifestCheckBox.Checked);
313 // Icon
314 AStream := TProjectIcon(ProjResources[TProjectIcon]).GetStream;
315 try
316 SetIconFromStream(AStream);
317 finally
318 AStream.Free;
319 end;
320 fIconChanged := False;
321 end;
322 end;
323
324 procedure TProjectApplicationOptionsFrame.WriteSettings(AOptions: TAbstractIDEOptions);
325 var
326 AStream: TStream;
327 begin
328 with (AOptions as TProjectIDEOptions).Project do
329 begin
330 Title := TitleEdit.Text;
331 Scaled := UseLCLScalingCheckBox.Checked;
332 if fIconChanged then
333 begin
334 AStream := GetIconAsStream;
335 try
336 ProjResources.ProjectIcon.SetStream(AStream);
337 finally
338 AStream.Free;
339 end;
340 end;
341 UseAppBundle := UseAppBundleCheckBox.Checked;
342 with ProjResources.XPManifest do
343 begin
344 UseManifest := UseXPManifestCheckBox.Checked;
345 DpiAware := TXPManifestDpiAware(DpiAwareComboBox.ItemIndex);
346 ExecutionLevel := TXPManifestExecutionLevel(ExecutionLevelComboBox.ItemIndex);
347 UIAccess := UIAccessCheckBox.Checked;
348 TextName := NameEdit.Text;
349 TextDesc := DescriptionEdit.Text;
350 end;
351 end;
352 end;
353
TProjectApplicationOptionsFrame.SupportedOptionsClassnull354 class function TProjectApplicationOptionsFrame.SupportedOptionsClass: TAbstractIDEOptionsClass;
355 begin
356 Result := TProjectIDEOptions;
357 end;
358
359 initialization
360 RegisterIDEOptionsEditor(GroupProject, TProjectApplicationOptionsFrame, ProjectOptionsApplication);
361
362 end.
363
364