Skip to content

Commit 561501e

Browse files
delphidabblerdelphidabbler
committed
Add FmRegisterCompilersDlg dialogue box to project.
This dialogue box is designed to present a list of Delphi compiler(s) to the user to enabled them to select which, if any, compiler(s) are to be registered. Designed for display at startup when unregistered versions of Delphi are detected. The dialogue includes an HTML resource that is used to display help information on the face of the dialogue box.
1 parent 7172b54 commit 561501e

File tree

6 files changed

+408
-1
lines changed

6 files changed

+408
-1
lines changed

‎Src/CodeSnip.dpr

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -372,7 +372,8 @@ uses
372372
UXMLDocumentEx in 'UXMLDocumentEx.pas',
373373
FmDeleteUserDBDlg in 'FmDeleteUserDBDlg.pas' {DeleteUserDBDlg},
374374
Compilers.UAutoDetect in 'Compilers.UAutoDetect.pas',
375-
Compilers.USettings in 'Compilers.USettings.pas';
375+
Compilers.USettings in 'Compilers.USettings.pas',
376+
FmRegisterCompilersDlg in 'FmRegisterCompilersDlg.pas' {RegisterCompilersDlg};
376377

377378
// Include resources
378379
{$Resource ExternalObj.tlb} // Type library file

‎Src/CodeSnip.dproj

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -577,6 +577,9 @@
577577
</DCCReference>
578578
<DCCReference Include="Compilers.UAutoDetect.pas"/>
579579
<DCCReference Include="Compilers.USettings.pas"/>
580+
<DCCReference Include="FmRegisterCompilersDlg.pas">
581+
<Form>RegisterCompilersDlg</Form>
582+
</DCCReference>
580583
<None Include="CodeSnip.todo"/>
581584
<BuildConfiguration Include="Base">
582585
<Key>Base</Key>

‎Src/FmRegisterCompilersDlg.dfm

Lines changed: 91 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,91 @@
1+
inherited RegisterCompilersDlg: TRegisterCompilersDlg
2+
Caption = 'RegisterCompilersDlg'
3+
ClientHeight = 453
4+
ExplicitWidth = 474
5+
ExplicitHeight = 482
6+
PixelsPerInch = 96
7+
TextHeight = 13
8+
inherited bvlBottom: TBevel
9+
Top = 403
10+
ExplicitTop = 403
11+
end
12+
inherited pnlBody: TPanel
13+
Width = 433
14+
Height = 389
15+
ExplicitWidth = 433
16+
ExplicitHeight = 389
17+
object lblDesc: TLabel
18+
Left = 0
19+
Top = 0
20+
Width = 33
21+
Height = 13
22+
Caption = 'lblDesc'
23+
FocusControl = clbCompilers
24+
end
25+
object clbCompilers: TCheckListBox
26+
Left = 0
27+
Top = 32
28+
Width = 361
29+
Height = 56
30+
IntegralHeight = True
31+
ItemHeight = 13
32+
TabOrder = 0
33+
end
34+
inline frmNotes: TFixedHTMLDlgFrame
35+
Left = 0
36+
Top = 159
37+
Width = 361
38+
Height = 199
39+
TabOrder = 1
40+
TabStop = True
41+
ExplicitTop = 159
42+
ExplicitWidth = 361
43+
ExplicitHeight = 199
44+
inherited pnlBrowser: TPanel
45+
Width = 361
46+
Height = 199
47+
ExplicitWidth = 361
48+
ExplicitHeight = 199
49+
inherited wbBrowser: TWebBrowser
50+
Width = 361
51+
Height = 199
52+
ExplicitWidth = 353
53+
ExplicitHeight = 199
54+
ControlData = {
55+
4C0000004F250000911400000000000000000000000000000000000000000000
56+
000000004C000000000000000000000001000000E0D057007335CF11AE690800
57+
2B2E126208000000000000004C0000000114020000000000C000000000000046
58+
8000000000000000000000000000000000000000000000000000000000000000
59+
00000000000000000100000000000000000000000000000000000000}
60+
end
61+
end
62+
end
63+
object chkDontShowAgain: TCheckBox
64+
Left = 0
65+
Top = 372
66+
Width = 145
67+
Height = 17
68+
Caption = '&Don'#39't show this again'
69+
TabOrder = 2
70+
end
71+
end
72+
inherited btnHelp: TButton
73+
Left = 362
74+
Top = 420
75+
ExplicitLeft = 362
76+
ExplicitTop = 420
77+
end
78+
inherited btnCancel: TButton
79+
Left = 282
80+
Top = 420
81+
ExplicitLeft = 282
82+
ExplicitTop = 420
83+
end
84+
inherited btnOK: TButton
85+
Left = 201
86+
Top = 420
87+
Default = False
88+
ExplicitLeft = 201
89+
ExplicitTop = 420
90+
end
91+
end

‎Src/FmRegisterCompilersDlg.pas

Lines changed: 250 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,250 @@
1+
{
2+
* This Source Code Form is subject to the terms of the Mozilla Public License,
3+
* v. 2.0. If a copy of the MPL was not distributed with this file, You can
4+
* obtain one at https://mozilla.org/MPL/2.0/
5+
*
6+
* Copyright (C) 2022, Peter Johnson (gravatar.com/delphidabbler).
7+
*
8+
* Implements a dialogue box that is optionally displayed at start-up when
9+
* Delphi compiler(s) are installed but not registered with CodeSnip. Allows the
10+
* user to specify which, if any, compiler(s) are to be registered.
11+
}
12+
13+
14+
unit FmRegisterCompilersDlg;
15+
16+
interface
17+
18+
uses
19+
// Delphi
20+
Forms,
21+
Classes,
22+
StdCtrls,
23+
Controls,
24+
CheckLst,
25+
ExtCtrls,
26+
SysUtils,
27+
// Project
28+
FmGenericOKDlg,
29+
FrBrowserBase,
30+
FrFixedHTMLDlg,
31+
FrHTMLDlg,
32+
Compilers.UCompilers,
33+
Compilers.UGlobals,
34+
UBaseObjects,
35+
UCSSBuilder;
36+
37+
type
38+
TRegisterCompilersDlg = class(TGenericOKDlg, INoPublicConstruct)
39+
lblDesc: TLabel;
40+
clbCompilers: TCheckListBox;
41+
frmNotes: TFixedHTMLDlgFrame;
42+
chkDontShowAgain: TCheckBox;
43+
procedure FormDestroy(Sender: TObject);
44+
procedure alMainUpdate(Action: TBasicAction; var Handled: Boolean);
45+
strict private
46+
var
47+
fCandidateCompilers: TCompilerList;
48+
fSelectedCompilers: TCompilerList;
49+
function CountTickedCompilers: Integer;
50+
procedure StoreSelectedCompilers;
51+
procedure SetCaptions;
52+
procedure PopulateList;
53+
strict protected
54+
procedure ConfigForm; override;
55+
procedure InitForm; override;
56+
procedure ArrangeForm; override;
57+
/// <summary>Handles HTML frame's OnBuildCSS event. Adds additional CSS
58+
/// required by HTML in this form.</summary>
59+
/// <param name="Sender">TObject [in] Reference to object triggering event.
60+
/// </param>
61+
/// <param name="CSSBuilder">TCSSBuilder [in] Object used to construct the
62+
/// CSS.</param>
63+
procedure BuildCSS(Sender: TObject; const CSSBuilder: TCSSBuilder);
64+
public
65+
class function Execute(const AOwner: TComponent;
66+
const CandidateCompilers: TCompilerList;
67+
const SelectedCompilers: TCompilerList): Boolean;
68+
end;
69+
70+
implementation
71+
72+
uses
73+
Compilers.USettings,
74+
UBox,
75+
UCSSUtils,
76+
UCtrlArranger;
77+
78+
{$R *.dfm}
79+
80+
{ TRegisterCompilersDlg }
81+
82+
procedure TRegisterCompilersDlg.alMainUpdate(Action: TBasicAction;
83+
var Handled: Boolean);
84+
begin
85+
inherited;
86+
btnOK.Enabled := chkDontShowAgain.Checked or (CountTickedCompilers > 0);
87+
end;
88+
89+
procedure TRegisterCompilersDlg.ArrangeForm;
90+
begin
91+
TCtrlArranger.SetLabelHeight(lblDesc);
92+
clbCompilers.Top := TCtrlArranger.BottomOf(lblDesc, 8);
93+
frmNotes.Top := TCtrlArranger.BottomOf(clbCompilers, 0);
94+
frmNotes.Height := frmNotes.DocHeight;
95+
chkDontShowAgain.Top := TCtrlArranger.BottomOf(frmNotes, 8);
96+
TCtrlArranger.AlignLefts(
97+
[lblDesc, clbCompilers, frmNotes, chkDontShowAgain], 0
98+
);
99+
pnlBody.ClientHeight := TCtrlArranger.TotalControlHeight(pnlBody) + 8;
100+
pnlBody.ClientWidth := TCtrlArranger.TotalControlWidth(pnlBody);
101+
inherited;
102+
end;
103+
104+
procedure TRegisterCompilersDlg.BuildCSS(Sender: TObject;
105+
const CSSBuilder: TCSSBuilder);
106+
var
107+
Selector: TCSSSelector;
108+
begin
109+
Selector := CSSBuilder.AddSelector('ol');
110+
Selector.AddProperty(TCSS.MarginProp(cssLeft, 24));
111+
Selector.AddProperty(TCSS.MarginProp(cssTop, 6));
112+
Selector.AddProperty(TCSS.MarginProp(cssBottom, 0));
113+
Selector.AddProperty(TCSS.PaddingProp(0));
114+
115+
Selector := CSSBuilder.AddSelector('ol li');
116+
Selector.AddProperty(TCSS.MarginProp(cssTop, 6));
117+
118+
Selector := CSSBuilder.AddSelector('ol li ul');
119+
Selector.AddProperty(TCSS.MarginProp(cssLeft, 16));
120+
Selector.AddProperty(TCSS.MarginProp(cssTop, 6));
121+
Selector.AddProperty(TCSS.MarginProp(cssBottom, 0));
122+
Selector.AddProperty(TCSS.PaddingProp(0));
123+
124+
Selector := CSSBuilder.AddSelector('ol li ul li');
125+
Selector.AddProperty(TCSS.MarginProp(cssTop, 0));
126+
end;
127+
128+
procedure TRegisterCompilersDlg.ConfigForm;
129+
begin
130+
inherited;
131+
frmNotes.OnBuildCSS := BuildCSS;
132+
frmNotes.Initialise('dlg-register-compilers.html');
133+
end;
134+
135+
function TRegisterCompilersDlg.CountTickedCompilers: Integer;
136+
var
137+
I: Integer;
138+
begin
139+
Result := 0;
140+
for I := 0 to Pred(clbCompilers.Count) do
141+
if clbCompilers.Checked[I] then
142+
Inc(Result);
143+
end;
144+
145+
class function TRegisterCompilersDlg.Execute(const AOwner: TComponent;
146+
const CandidateCompilers: TCompilerList;
147+
const SelectedCompilers: TCompilerList): Boolean;
148+
var
149+
Dlg: TRegisterCompilersDlg;
150+
begin
151+
Assert(Assigned(CandidateCompilers),
152+
ClassName + '.Execute: AvailCompilers list is nil');
153+
Assert(Assigned(SelectedCompilers),
154+
ClassName + '.Execute: CompilersToReg list is nil');
155+
Assert(CandidateCompilers.Count > 0,
156+
ClassName + '.Execute: AvailCompilers list must not be empty');
157+
158+
Dlg := InternalCreate(AOwner);
159+
try
160+
Dlg.fCandidateCompilers := CandidateCompilers; // reference to list
161+
Dlg.fSelectedCompilers := SelectedCompilers; // reference to list
162+
Result := Dlg.ShowModal = mrOK;
163+
if Result then
164+
begin
165+
Dlg.StoreSelectedCompilers;
166+
TCompilerSettings.PermitStartupDetection :=
167+
not Dlg.chkDontShowAgain.Checked;
168+
end;
169+
finally
170+
Dlg.Free;
171+
end;
172+
end;
173+
174+
procedure TRegisterCompilersDlg.FormDestroy(Sender: TObject);
175+
var
176+
Idx: Integer;
177+
begin
178+
// Free TBox<> objects associated with compiler list items
179+
for Idx := Pred(clbCompilers.Count) downto 0 do
180+
clbCompilers.Items.Objects[Idx].Free;
181+
inherited;
182+
end;
183+
184+
procedure TRegisterCompilersDlg.InitForm;
185+
begin
186+
inherited;
187+
SetCaptions;
188+
PopulateList;
189+
end;
190+
191+
procedure TRegisterCompilersDlg.PopulateList;
192+
var
193+
Compiler: ICompiler;
194+
begin
195+
clbCompilers.Items.BeginUpdate;
196+
try
197+
clbCompilers.Clear;
198+
for Compiler in fCandidateCompilers do
199+
begin
200+
clbCompilers.Items.AddObject(
201+
Compiler.GetName,
202+
TBox<ICompiler>.Create(Compiler)
203+
);
204+
end;
205+
finally
206+
clbCompilers.Items.EndUpdate;
207+
end;
208+
Assert(clbCompilers.Count > 0,
209+
ClassName + '.PopulateList: compiler list empty');
210+
clbCompilers.ItemIndex := 0;
211+
end;
212+
213+
procedure TRegisterCompilersDlg.SetCaptions;
214+
resourcestring
215+
sFormCaptionS = 'Unregistered Delphi Installations Detected';
216+
sFormCaptionP = 'Unregistered Delphi Installation Detected';
217+
sDescS = '&Unregistered compiler. Tick to register:';
218+
sDescP = '&Unregistered compilers. Tick the ones to be registered:';
219+
begin
220+
// Set form and description captions
221+
if fCandidateCompilers.Count = 1 then
222+
begin
223+
Caption := sFormCaptionS;
224+
lblDesc.Caption := sDescS;
225+
end
226+
else
227+
begin
228+
// fCandidateCompilers.Count > 1 because fCandidateCompilers.Count > 0 assured by
229+
// assertions in Execute method
230+
Caption := sFormCaptionP;
231+
lblDesc.Caption := sDescP;
232+
end;
233+
end;
234+
235+
procedure TRegisterCompilersDlg.StoreSelectedCompilers;
236+
var
237+
I: Integer;
238+
begin
239+
fSelectedCompilers.Clear;
240+
for I := 0 to Pred(clbCompilers.Count) do
241+
if clbCompilers.Checked[I] then
242+
begin
243+
fSelectedCompilers.Add(
244+
TBox<ICompiler>(clbCompilers.Items.Objects[I]).Value
245+
);
246+
end;
247+
end;
248+
249+
end.
250+

‎Src/HTML.hrc

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,9 @@ Res\HTML\dlg-whatsnew.html
4343
# delete database dialogue
4444
Res\HTML\dlg-dbdelete.html
4545

46+
# auto-register new compilers dialogue
47+
Res\HTML\dlg-register-compilers.html
48+
4649

4750
# Detail pane pages, scripts and CSS
4851
# ==================================

0 commit comments

Comments
 (0)