Skip to content

Commit b4710f8

Browse files
Robert Di PardoRobert Di Pardo
Robert Di Pardo
authored and
Robert Di Pardo
committed
Improve the About dialog
1 parent 77f3ddc commit b4710f8

6 files changed

Lines changed: 331 additions & 28 deletions

File tree

‎.gitmodules‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
[submodule "fpGUI"]
2+
path = src/Forms/fpg
3+
url = https://github.com/graemeg/fpGUI.git
4+
branch = maint

‎src/Common/L_VersionInfoW.pas‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
unit L_VersionInfoW;
22

3+
{$IFDEF FPC}
4+
{$codePage UTF8}
5+
{$ENDIF}
6+
37
interface
48

59
uses
@@ -98,7 +102,7 @@ procedure TFileVersionInfo.SetFileName(const AFileName: string);
98102
var
99103
Value : PChar;
100104
begin
101-
SubBlock := WideFormat('\\StringFileInfo\\%.4x%.4x\\%s', [PLang.wLanguage, PLang.wCodePage, AName]);
105+
SubBlock := Format('\\StringFileInfo\\%.4x%.4x\\%s', [PLang.wLanguage, PLang.wCodePage, AName]);
102106
if VerQueryValue(Buffer, PChar(SubBlock), Pointer(Value), Dummy) then
103107
Result := string(Value)
104108
else

‎src/Forms/AboutForm.pas‎

Lines changed: 291 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,291 @@
1+
unit AboutForm;
2+
3+
{$IFDEF FPC}{$mode delphi}{$ENDIF}
4+
5+
{
6+
Copyright (c) 2022 Robert Di Pardo <dipardo.r@gmail.com>
7+
8+
This Source Code Form is subject to the terms of the Mozilla Public License,
9+
v. 2.0. If a copy of the MPL was not distributed with this file, You can
10+
obtain one at http://mozilla.org/MPL/2.0/.
11+
}
12+
13+
interface
14+
15+
uses
16+
Classes,
17+
fpg_base,
18+
fpg_main,
19+
fpg_form,
20+
fpg_panel,
21+
fpg_button,
22+
L_VersionInfoW;
23+
24+
const
25+
Repo = 'https://bitbucket.org/rdipardo/htmltag/downloads';
26+
Author = #$00A9' 2011-2020 %s (v0.1 - v1.1)';
27+
Maintainer = #$00A9' 2022 Robert Di Pardo (since v1.2)';
28+
FpgAuthors = #$00A9' Graeme Geldenhuys et al.';
29+
License = 'Licensed under the MPL 1.1';
30+
FpgLicense = 'Licensed under the LGPL 2.1 with static linking exception';
31+
EntitiesConf = 'HTMLTag-entities.ini';
32+
BtnWidth: integer = 85;
33+
34+
type
35+
TFrmAbout = class(TfpgForm)
36+
txtRelNotes: TfpgPanel;
37+
txtBugURL: TfpgPanel;
38+
txtDownloadSite: TfpgPanel;
39+
txtPluginVersion: TfpgPanel;
40+
txtAuthor: TfpgPanel;
41+
txtMaintainer: TfpgPanel;
42+
txtLicense: TfpgPanel;
43+
txtFpgAuthors: TfpgPanel;
44+
lblFpgLicense: TfpgPanel;
45+
txtFpgLicense: TfpgPanel;
46+
lblHomeDir: TfpgPanel;
47+
txtHomeDir: TfpgPanel;
48+
lblConfigDir: TfpgPanel;
49+
txtConfigDir: TfpgPanel;
50+
lblEntities: TfpgPanel;
51+
txtEntities: TfpgPanel;
52+
lblSpacer1: TfpgPanel;
53+
lblSpacer2: TfpgPanel;
54+
btnSpacer: TfpgPanel;
55+
btnClose: TfpgButton;
56+
public
57+
constructor Create(AOwner: TComponent); override;
58+
destructor Destroy; override;
59+
published
60+
procedure DoOnShow({%H-}Sender: TObject);
61+
procedure FormClose({%H-}Sender: TObject);
62+
procedure GoToChangelog({%H-}Sender: TObject);
63+
procedure FollowPath(Sender: TObject);
64+
procedure ShowLink(Sender: TObject);
65+
procedure RevertCursor(Sender: TObject);
66+
private
67+
FVersion: TFileVersionInfo;
68+
FDLLName: string;
69+
procedure FindEntities;
70+
procedure SetConfigFilePath(Path: TfpgPanel);
71+
procedure WrapFilePath(Path: TfpgPanel);
72+
procedure SetUrl(Lbl: TfpgPanel);
73+
function MakeText(const Txt: string; const Height: TfpgCoord = 18): TfpgPanel;
74+
end;
75+
76+
implementation
77+
78+
uses
79+
SysUtils,
80+
StrUtils,
81+
Windows,
82+
L_SpecialFolders,
83+
U_Npp_HTMLTag;
84+
85+
constructor TFrmAbout.Create(AOwner: TComponent);
86+
begin
87+
inherited Create(AOwner);
88+
try
89+
FDLLName := TSpecialFolders.DLLFullName;
90+
FVersion := TFileVersionInfo.Create(FDLLName);
91+
Width := 575;
92+
Height := 450;
93+
BackgroundColor := clWhite;
94+
WindowAttributes := [waBorderless];
95+
WindowPosition := wpScreenCenter;
96+
Sizeable := False;
97+
OnShow := DoOnShow;
98+
WindowTitle := 'About';
99+
100+
if Assigned(FVersion) then
101+
SetWindowTitle(FVersion.FileDescription);
102+
103+
txtPluginVersion := MakeText(UTF8ToAnsi(UTF8Encode(Npp.Version)), 24);
104+
txtPluginVersion.FontDesc := 'Tahoma-9';
105+
106+
txtRelNotes := MakeText('Release Notes', 24);
107+
SetUrl(txtRelNotes);
108+
txtRelNotes.OnClick := GoToChangelog;
109+
110+
if Assigned(FVersion) then
111+
begin
112+
txtBugURL := MakeText('Bugs', 24);
113+
txtBugURL.Hint := FVersion.Comments;
114+
SetUrl(txtBugURL);
115+
end;
116+
117+
txtDownloadSite := MakeText('Downloads', 24);
118+
txtDownloadSite.Hint := Repo;
119+
SetUrl(txtDownloadSite);
120+
lblSpacer1 := MakeText(' ', 8);
121+
122+
if Assigned(FVersion) then
123+
begin
124+
txtAuthor := MakeText(UTF8Encode(WideFormat(Author, [FVersion.LegalCopyright])));
125+
end;
126+
127+
txtMaintainer := MakeText(Maintainer);
128+
txtLicense := MakeText(License, 32);
129+
130+
lblFpgLicense := MakeText('Using the fpGUI Toolkit');
131+
txtFpgAuthors := MakeText(FpgAuthors);
132+
txtFpgLicense := MakeText(FpgLicense);
133+
lblSpacer2 := MakeText(' ', 8);
134+
135+
lblHomeDir := MakeText('Plugin location');
136+
txtHomeDir := MakeText(ExtractFileDir(FDLLName), 24);
137+
138+
lblConfigDir := MakeText('Config location');
139+
txtConfigDir := MakeText(UTF8ToAnsi(UTF8Encode(Npp.App.ConfigFolder)), 24);
140+
141+
lblEntities := MakeText('HTML entities file');
142+
txtEntities := MakeText('', 24);
143+
144+
btnSpacer := MakeText(' ', 12);
145+
146+
btnClose := CreateButton(self, 0, 0, BtnWidth, 'OK', FormClose);
147+
with btnClose do
148+
begin
149+
Align := AlClient;
150+
Flat := True;
151+
MaxHeight := (BtnWidth div 2);
152+
TabOrder := 0;
153+
end;
154+
155+
except
156+
on E: Exception do
157+
begin
158+
MessageBox(Npp.App.WindowHandle, PChar(E.Message), PChar(E.Message),
159+
MB_ICONERROR);
160+
end;
161+
end;
162+
end;
163+
164+
destructor TFrmAbout.Destroy;
165+
begin
166+
if Assigned(FVersion) then
167+
FreeAndNil(FVersion);
168+
169+
inherited;
170+
end;
171+
172+
procedure TFrmAbout.DoOnShow({%H-}Sender: TObject);
173+
begin
174+
FindEntities;
175+
btnClose.Focused := True;
176+
end;
177+
178+
procedure TFrmAbout.FormClose({%H-}Sender: TObject);
179+
begin
180+
Close;
181+
end;
182+
183+
procedure TFrmAbout.GoToChangelog({%H-}Sender: TObject);
184+
var
185+
ChangeLog: WideString;
186+
begin
187+
ChangeLog := 'https://bitbucket.org/rdipardo/htmltag/src/HEAD/NEWS.textile';
188+
189+
if Assigned(FVersion) then
190+
ChangeLog := WideFormat(
191+
'https://bitbucket.org/rdipardo/htmltag/src/v%d.%d.%d/NEWS.textile',
192+
[FVersion.MajorVersion, FVersion.MinorVersion, FVersion.Revision]);
193+
194+
Npp.ShellExecute(ChangeLog);
195+
Close;
196+
end;
197+
198+
procedure TFrmAbout.FollowPath(Sender: TObject);
199+
begin
200+
Npp.ShellExecute(PChar(ReplaceStr(TfpgPanel(Sender).Hint, '...'#13#10, '')));
201+
Close;
202+
end;
203+
204+
procedure TFrmAbout.ShowLink(Sender: TObject);
205+
begin
206+
TfpgPanel(Sender).MouseCursor := mcHand;
207+
end;
208+
209+
procedure TFrmAbout.RevertCursor(Sender: TObject);
210+
begin
211+
TfpgPanel(Sender).MouseCursor := mcDefault;
212+
end;
213+
214+
function TFrmAbout.MakeText(const Txt: string; const Height: TfpgCoord): TfpgPanel;
215+
begin
216+
Result := CreatePanel(self, 0, 0, self.Width, Height, txt, bsFlat, taCenter);
217+
Result.Align := alTop;
218+
Result.LineSpace := -1;
219+
Result.ParentBackgroundColor := True;
220+
end;
221+
222+
procedure TFrmAbout.SetUrl(Lbl: TfpgPanel);
223+
begin
224+
with Lbl do
225+
begin
226+
OnMouseEnter := ShowLink;
227+
OnMouseExit := RevertCursor;
228+
OnClick := FollowPath;
229+
TextColor := clHyperLink;
230+
FontDesc := 'Tahoma-9';
231+
end;
232+
end;
233+
234+
procedure TFrmAbout.SetConfigFilePath(Path: TfpgPanel);
235+
begin
236+
with Path do
237+
begin
238+
if FileExists(Text) then
239+
begin
240+
Hint := Text;
241+
SetUrl(Path);
242+
FontDesc := FPG_DEFAULT_FONT_DESC;
243+
end
244+
else
245+
begin
246+
Text := 'Not found';
247+
TextColor := clCrimson;
248+
OnMouseEnter := nil;
249+
OnMouseExit := nil;
250+
OnClick := nil;
251+
end;
252+
end;
253+
WrapFilePath(Path);
254+
end;
255+
256+
procedure TFrmAbout.FindEntities;
257+
var
258+
Entities: string;
259+
begin
260+
Entities := IncludeTrailingPathDelimiter(txtConfigDir.Text) + EntitiesConf;
261+
262+
if not FileExists(Entities) then
263+
txtEntities.Text := IncludeTrailingPathDelimiter(txtHomeDir.Text) + EntitiesConf
264+
else
265+
txtEntities.Text := Entities;
266+
267+
SetConfigFilePath(txtEntities);
268+
end;
269+
270+
procedure TFrmAbout.WrapFilePath(Path: TfpgPanel);
271+
var
272+
Txt: string;
273+
i: integer;
274+
begin
275+
with Path do
276+
begin
277+
Txt := Text;
278+
if Length(Txt) > BtnWidth then
279+
begin
280+
// break long path names at directory separator
281+
for i := 1 to Length(Txt) do
282+
begin
283+
if (Txt[i] = PathDelim) and (i mod 8 = 0) then
284+
Text := Concat(LeftStr(Txt, i), '...'#13#10,
285+
RightStr(Txt, Length(Txt) - i));
286+
end;
287+
end;
288+
end;
289+
end;
290+
291+
end.

‎src/Forms/fpg‎

Submodule fpg added at 1c0e363

‎src/U_Npp_HTMLTag.pas‎

Lines changed: 10 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ interface
66
uses
77
SysUtils, Windows,
88
NppPlugin,
9+
fpg_main,
10+
AboutForm,
911
NppSimpleObjects, L_VersionInfoW;
1012

1113
type
@@ -31,6 +33,7 @@ TNppPluginHTMLTag = class(TNppPlugin)
3133
procedure ShellExecute(const FullName: string; const Verb: string = 'open'; const WorkingDir: string = ''; const ShowWindow: Integer = SW_SHOWDEFAULT);
3234

3335
property App: TApplication read FApp;
36+
property Version: nppString read FVersionStr;
3437
end;
3538

3639
procedure _commandFindMatchingTag(); cdecl;
@@ -45,6 +48,7 @@ procedure _commandAbout(); cdecl;
4548

4649
var
4750
Npp: TNppPluginHTMLTag;
51+
About: TFrmAbout;
4852

4953
////////////////////////////////////////////////////////////////////////////////////////////////////
5054
implementation
@@ -187,6 +191,8 @@ destructor TNppPluginHTMLTag.Destroy;
187191
begin
188192
if Assigned(FVersionInfo) then
189193
FreeAndNil(FVersionInfo);
194+
if Assigned(About) then
195+
FreeAndNil(About);
190196
inherited;
191197
end;
192198

@@ -338,33 +344,12 @@ procedure TNppPluginHTMLTag.commandDecodeJS;
338344

339345
{ ------------------------------------------------------------------------------------------------ }
340346
procedure TNppPluginHTMLTag.commandAbout;
341-
var
342-
Text, DLLName: string;
343347
begin
344348
try
345-
DLLName := TSpecialFolders.DLLFullName;
346-
if not Assigned(FVersionInfo) then begin
347-
FVersionInfo := TFileVersionInfo.Create(DLLName);
349+
if not Assigned(About) then begin
350+
About := TFrmAbout.Create(nil);
348351
end;
349-
350-
Text := Format('%s'#10#10
351-
+ 'Plug-in location: %s'#10
352-
+ 'Config location: %s'#10
353-
+ 'Bugs: %s'#10
354-
+ 'Download: %s'#10#10
355-
+ #$00A9' 2011-2020 %s - %s'#10
356-
+ ' a.k.a. %s - %s (v0.1 - v1.1)'#10
357-
+ #$00A9' 2022 Robert Di Pardo (since v1.2)'#10#10
358-
+ 'Licensed under the %s - %s',
359-
[FVersionStr,
360-
ExtractFileDir(DLLName),
361-
App.ConfigFolder,
362-
FVersionInfo.Comments,
363-
'https://bitbucket.org/rdipardo/htmltag/downloads',
364-
FVersionInfo.LegalCopyright, 'http://fossil.2of4.net/npp_htmltag', // 'http://martijn.coppoolse.com/software',
365-
'vor0nwe', 'http://sourceforge.net/users/vor0nwe',
366-
'MPL 1.1', 'http://www.mozilla.org/MPL/1.1']);
367-
MessageBox(App.WindowHandle, PChar(Text), PChar(FVersionInfo.FileDescription), MB_ICONINFORMATION)
352+
About.Show;
368353
except
369354
HandleException(ExceptObject, ExceptAddr);
370355
end;
@@ -404,4 +389,5 @@ function TNppPluginHTMLTag.SupportsBigFiles: Boolean;
404389
////////////////////////////////////////////////////////////////////////////////////////////////////
405390
initialization
406391
Npp := TNppPluginHTMLTag.Create;
392+
fpgApplication.Initialize;
407393
end.

0 commit comments

Comments
 (0)