tvplanit: In Aboutbox, replace font Ms Sans Serif by Default; make links clickable.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4694 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-08 19:14:13 +00:00
parent 4308a684f9
commit 6c36a9912a
2 changed files with 67 additions and 57 deletions

View File

@ -10,10 +10,11 @@ object frmAbout: TfrmAbout
ClientHeight = 312
ClientWidth = 471
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Name = 'Default'
OnActivate = FormActivate
OnMouseMove = FormMouseMove
Position = poScreenCenter
LCLVersion = '1.7'
object Bevel3: TBevel
Left = 152
Height = 96
@ -30,110 +31,114 @@ object frmAbout: TfrmAbout
end
object ProgramName: TLabel
Left = 152
Height = 14
Height = 16
Top = 8
Width = 92
Width = 80
Caption = 'Visual PlanIt'
Font.Height = -13
Font.Name = 'MS Sans Serif'
Font.Name = 'Default'
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object VisitUsLabel: TLabel
Left = 153
Height = 15
Left = 152
Height = 14
Top = 109
Width = 287
Width = 217
Caption = 'Visit the Visual PlanIt project on SourceForge'
ParentColor = False
end
object GeneralNewsgroupsLabel: TLabel
Left = 160
Height = 15
Height = 14
Top = 168
Width = 179
Width = 135
Caption = 'Visual PlanIt support groups'
ParentColor = False
end
object lblTurboLink: TLabel
Cursor = crHandPoint
Left = 161
Height = 13
Height = 14
Top = 125
Width = 232
Width = 193
Caption = 'http://sourceforge.net/projects/tpvplanit/'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Name = 'Default'
Font.Style = [fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblTurboLinkClick
OnMouseMove = lblTurboLinkMouseMove
end
object lblHelp: TLabel
Cursor = crHandPoint
Left = 168
Height = 13
Height = 14
Top = 198
Width = 334
Width = 278
Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241880'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Name = 'Default'
Font.Style = [fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblHelpClick
OnMouseMove = lblTurboLinkMouseMove
end
object CopyrightLabel: TLabel
Left = 7
Height = 15
Height = 14
Top = 273
Width = 332
Width = 256
Caption = '(C) Copyright 2001, TurboPower Software Company.'
ParentColor = False
end
object RightsReservedLabel: TLabel
Left = 7
Height = 15
Height = 14
Top = 289
Width = 120
Width = 92
Caption = 'All rights reserved.'
ParentColor = False
end
object lblGeneralDiscussion: TLabel
Cursor = crHandPoint
Left = 168
Height = 13
Height = 14
Top = 230
Width = 334
Width = 278
Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241879'
Font.Color = clBlue
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Name = 'Default'
Font.Style = [fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblGeneralDiscussionClick
OnMouseMove = lblTurboLinkMouseMove
end
object Label2: TLabel
Left = 168
Height = 15
Height = 14
Top = 186
Width = 34
Width = 24
Caption = 'Help:'
ParentColor = False
end
object Label3: TLabel
Left = 168
Height = 15
Height = 14
Top = 217
Width = 127
Width = 97
Caption = 'General Discussion:'
ParentColor = False
end
object Label1: TLabel
Left = 160
Left = 152
Height = 49
Top = 40
Width = 265
@ -1283,7 +1288,6 @@ object frmAbout: TfrmAbout
E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117E117
E117E117E117E117E117E1FF9139
}
Transparent = False
end
end
object OKButton: TButton

View File

@ -72,8 +72,6 @@ type
procedure OKButtonClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure lblTurboLinkClick(Sender: TObject);
procedure lblFreeUpdateCenterClick(Sender: TObject);
procedure lblTurboPowerLiveClick(Sender: TObject);
procedure lblTurboLinkMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
@ -113,6 +111,13 @@ uses
resourcestring
cBrowserError = 'Unable to start web browser. Make sure you have it properly setup on your system.';
const
TURBO_LINK_URL = 'http://sourceforge.net/projects/tpvplanit/';
HELP_URL = 'http://sourceforge.net/forum/forum.php?forum_id=241880';
NEWS_SPECIFIC_URL = 'news://news.turbopower.com/turbopower.public.support.visualplanit';
GENERAL_DISCUSSION_URL = 'http://sourceforge.net/forum/forum.php?forum_id=241879';
{*** TVpAboutProperty ***}
function TVpAboutProperty.GetAttributes: TPropertyAttributes;
@ -141,13 +146,19 @@ end;
{=====}
procedure TfrmAbout.FormActivate(Sender: TObject);
const
{$IFDEF LCL}
COPYRIGHT = '©';
{$ELSE}
COPYRIGHT = #169
{$ENDIF}
var
Year, Junk: Word;
begin
ProgramName.Caption := VpProductName + ' ' + VpVersionStr;
DecodeDate(Now, Year, junk, junk);
CopyrightLabel.Caption := #169 + ' Copyright 2000 - ' + IntToStr(Year)
+ ', TurboPower Software Company.';
CopyrightLabel.Caption := Format('%s Copyright 2000 - %d, TurboPower Software Company.',
[COPYRIGHT, Year]);
lblTurboLink.Cursor := crHandPoint;
lblHelp.Cursor := crHandPoint;
@ -157,23 +168,18 @@ end;
procedure TfrmAbout.lblTurboLinkClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open', 'http://sourceforge.net/projects/tpvplanit/',
'', '', SW_SHOWNORMAL) <= 32
{$IFDEF LCL}
if not OpenURL(TURBO_LINK_URL)
{$ELSE}
if ShellExecute(0, 'open', TURBO_LINK_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblFreeUpdateCenterClick(Sender : TObject);
begin
end;
{=====}
procedure TfrmAbout.lblTurboPowerLiveClick(Sender : TObject);
begin
end;
{=====}
procedure TfrmAbout.lblTurboLinkMouseMove(Sender: TObject;
@ -192,37 +198,37 @@ end;
procedure TfrmAbout.lblHelpClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'http://sourceforge.net/forum/forum.php?forum_id=241880', '', '',
SW_SHOWNORMAL) <= 32
{$IFDEF LCL}
if not OpenUrl(HELP_URL)
{$ELSE}
if ShellExecute(0, 'open', HELP_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblNewsSpecificClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'news://news.turbopower.com/turbopower.public.support.visualplanit',
'', '', SW_SHOWNORMAL) <= 32
{$IFDEF LCL}
if not OpenURL(NEWS_SPECIFIC_URL)
{$ELSE}
if ShellExecute(0, 'open', NEWS_SPECIFIC_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
{=====}
procedure TfrmAbout.lblGeneralDiscussionClick(Sender: TObject);
begin
{$IFNDEF LCL}
if ShellExecute(0, 'open',
'http://sourceforge.net/forum/forum.php?forum_id=241879', '', '',
SW_SHOWNORMAL) <= 32
{$IFDEF LCL}
if not OpenURL(GENERAL_DISCUSSION_URL)
{$ELSE}
if ShellExecute(0, 'open', GENERAL_DISCUSSION_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(cBrowserError);
{$ENDIF}
end;
end.