Skip to content

Commit d96b0a0

Browse files
damiengdamieng
committed
Add version info to about box
1 parent b9350cc commit d96b0a0

File tree

4 files changed

+123
-98
lines changed

4 files changed

+123
-98
lines changed

‎Source/About.lfm

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -152,12 +152,12 @@ object frmAbout: TfrmAbout
152152
Width = 265
153153
end
154154
object lblVersion: TLabel
155-
Left = 303
155+
Left = 64
156156
Height = 13
157157
Top = 32
158-
Width = 26
159-
Alignment = taRightJustify
158+
Width = 265
160159
Anchors = [akTop, akRight]
160+
AutoSize = False
161161
Caption = '0.0.0'
162162
ParentColor = False
163163
end

‎Source/About.pas

Lines changed: 118 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -1,93 +1,118 @@
1-
unit About;
2-
3-
{$MODE Delphi}
4-
5-
{
6-
Disk Image Manager - About window
7-
8-
Copyright (c) Damien Guard. All rights reserved.
9-
Licensed under the Apache License, Version 2.0 (the "License");
10-
you may not use this file except in compliance with the License.
11-
You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
12-
}
13-
14-
interface
15-
16-
uses
17-
LCLIntf, Forms, ExtCtrls, StdCtrls, Graphics;
18-
19-
type
20-
TfrmAbout = class(TForm)
21-
btnOK: TButton;
22-
imgAppIcon: TImage;
23-
lblTitle: TLabel;
24-
bvLine: TBevel;
25-
lblVersion: TLabel;
26-
timFade: TTimer;
27-
lblWeb: TLabel;
28-
procedure FormCreate(Sender: TObject);
29-
procedure FormShow(Sender: TObject);
30-
procedure btnOKClick(Sender: TObject);
31-
procedure lblWebClick(Sender: TObject);
32-
procedure timFadeTimer(Sender: TObject);
33-
end;
34-
35-
var
36-
frmAbout: TfrmAbout;
37-
38-
implementation
39-
40-
uses
41-
Main;
42-
43-
{$R *.lfm}
44-
45-
procedure TfrmAbout.FormCreate(Sender: TObject);
46-
begin
47-
Caption := 'About ' + Application.Title;
48-
lblTitle.Caption := Application.Title;
49-
lblVersion.Caption := 'Compiled: ' + {$I %DATE%} + ' ' + {$I %TIME%};
50-
end;
51-
52-
procedure TfrmAbout.timFadeTimer(Sender: TObject);
53-
begin
54-
if (timFade.Tag > 0) then
55-
if (frmAbout.AlphaBlendValue < 250) then
56-
frmAbout.AlphaBlendValue := frmAbout.AlphaBlendValue + timFade.Tag
57-
else
58-
begin
59-
timFade.Enabled := False;
60-
frmAbout.AlphaBlendValue := 255;
61-
end
62-
else
63-
if (frmAbout.AlphaBlendValue > 5) then
64-
frmAbout.AlphaBlendValue := frmAbout.AlphaBlendValue + timFade.Tag
65-
else
66-
begin
67-
timFade.Enabled := False;
68-
frmAbout.AlphaBlendValue := 0;
69-
Close;
70-
end;
71-
end;
72-
73-
procedure TfrmAbout.FormShow(Sender: TObject);
74-
begin
75-
frmAbout.Font := frmMain.Font;
76-
frmAbout.AlphaBlendValue := 0;
77-
lblVersion.Font.Color := clBtnShadow;
78-
timFade.Tag := 4;
79-
timFade.Enabled := True;
80-
end;
81-
82-
procedure TfrmAbout.lblWebClick(Sender: TObject);
83-
begin
84-
OpenDocument(PChar(TLabel(Sender).Caption));
85-
end;
86-
87-
procedure TfrmAbout.btnOKClick(Sender: TObject);
88-
begin
89-
timFade.Tag := -4;
90-
timFade.Enabled := True;
91-
end;
92-
93-
end.
1+
unit About;
2+
3+
{$MODE Delphi}
4+
5+
{
6+
Disk Image Manager - About window
7+
8+
Copyright (c) Damien Guard. All rights reserved.
9+
Licensed under the Apache License, Version 2.0 (the "License");
10+
you may not use this file except in compliance with the License.
11+
You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
12+
}
13+
14+
interface
15+
16+
uses
17+
LCLIntf, Forms, ExtCtrls, StdCtrls, Graphics, SysUtils, ShellApi, Windows;
18+
19+
type
20+
TfrmAbout = class(TForm)
21+
btnOK: TButton;
22+
imgAppIcon: TImage;
23+
lblTitle: TLabel;
24+
bvLine: TBevel;
25+
lblVersion: TLabel;
26+
timFade: TTimer;
27+
lblWeb: TLabel;
28+
function GetAppVersion: String;
29+
procedure FormCreate(Sender: TObject);
30+
procedure FormShow(Sender: TObject);
31+
procedure btnOKClick(Sender: TObject);
32+
procedure lblWebClick(Sender: TObject);
33+
procedure timFadeTimer(Sender: TObject);
34+
end;
35+
36+
var
37+
frmAbout: TfrmAbout;
38+
39+
40+
implementation
41+
42+
uses
43+
Main;
44+
45+
{$R *.lfm}
46+
47+
function TfrmAbout.GetAppVersion: String;
48+
var
49+
Size, Size2: DWord;
50+
Pt, Pt2: Pointer;
51+
begin
52+
Size := GetFileVersionInfoSize(PChar(ParamStr(0)),Size2);
53+
if (Size > 0) then
54+
begin
55+
GetMem(Pt,Size);
56+
try
57+
GetFileVersionInfo(PChar(ParamStr(0)),0,Size,Pt);
58+
VerQueryValue(Pt,'\',Pt2,Size2);
59+
with TVSFixedFileInfo(Pt2^) do
60+
begin
61+
Result := Format('%d.%d.%d.%d', [HiWord(dwFileVersionMS),LoWord(dwFileVersionMS),
62+
HiWord(dwFileVersionLS),LoWord(dwFileVersionLS)]);
63+
end;
64+
finally
65+
FreeMem(Pt);
66+
end;
67+
end;
68+
end;
69+
70+
procedure TfrmAbout.FormCreate(Sender: TObject);
71+
begin
72+
Caption := 'About ' + Application.Title;
73+
lblTitle.Caption := Application.Title;
74+
lblVersion.Caption := Format('%s build: %s compiled %s %s', [{$I %FPCTARGETOS%}, GetAppVersion, {$I %DATE%}, {$I %TIME%}]);
75+
end;
76+
77+
procedure TfrmAbout.timFadeTimer(Sender: TObject);
78+
begin
79+
if (timFade.Tag > 0) then
80+
if (frmAbout.AlphaBlendValue < 250) then
81+
frmAbout.AlphaBlendValue := frmAbout.AlphaBlendValue + timFade.Tag
82+
else
83+
begin
84+
timFade.Enabled := False;
85+
frmAbout.AlphaBlendValue := 255;
86+
end
87+
else
88+
if (frmAbout.AlphaBlendValue > 5) then
89+
frmAbout.AlphaBlendValue := frmAbout.AlphaBlendValue + timFade.Tag
90+
else
91+
begin
92+
timFade.Enabled := False;
93+
frmAbout.AlphaBlendValue := 0;
94+
Close;
95+
end;
96+
end;
97+
98+
procedure TfrmAbout.FormShow(Sender: TObject);
99+
begin
100+
frmAbout.Font := frmMain.Font;
101+
frmAbout.AlphaBlendValue := 0;
102+
lblVersion.Font.Color := clBtnShadow;
103+
timFade.Tag := 4;
104+
timFade.Enabled := True;
105+
end;
106+
107+
procedure TfrmAbout.lblWebClick(Sender: TObject);
108+
begin
109+
OpenDocument(PChar(TLabel(Sender).Caption));
110+
end;
111+
112+
procedure TfrmAbout.btnOKClick(Sender: TObject);
113+
begin
114+
timFade.Tag := -4;
115+
timFade.Enabled := True;
116+
end;
117+
118+
end.

‎Source/DiskImageManager.lpi

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,8 @@
2929
<UseVersionInfo Value="True"/>
3030
<AutoIncrementBuild Value="True"/>
3131
<MajorVersionNr Value="2"/>
32-
<MinorVersionNr Value="3"/>
33-
<BuildNr Value="104"/>
32+
<MinorVersionNr Value="4"/>
33+
<BuildNr Value="105"/>
3434
<StringTable CompanyName="Envy Technologies" InternalName="Disk Image Manager" LegalCopyright="Copyright 2002-2023 Damien Guard." OriginalFilename="DiskImageManager.exe" ProductName="Disk Image Manager"/>
3535
</VersionInfo>
3636
<BuildModes Count="2">

‎Source/DiskImageManager.res

0 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)