pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Remove redundant code in AboutBox. Make sure all links are working.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4748 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-06-14 11:19:09 +00:00
parent 597407206b
commit 4f72acf8cd
2 changed files with 39 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
components/tvplanit/source/vpabout.lfm
View File

@ -2,13 +2,13 @@ object frmAbout: TfrmAbout
Left = 282
Height = 312
Top = 205
Width = 567
Width = 561
HorzScrollBar.Page = 470
VertScrollBar.Page = 311
BorderStyle = bsDialog
Caption = 'About Visual PlanIt'
ClientHeight = 312
ClientWidth = 567
ClientWidth = 561
OnActivate = FormActivate
OnMouseMove = FormMouseMove
Position = poScreenCenter
@ -17,15 +17,16 @@ object frmAbout: TfrmAbout
Left = 152
Height = 96
Top = 160
Width = 409
Width = 403
Anchors = [akTop, akLeft, akRight]
Shape = bsFrame
OnMouseMove = lblLinkMouseMove
end
object Bevel2: TBevel
Left = 6
Height = 17
Top = 265
Width = 555
Width = 549
Anchors = [akTop, akLeft, akRight]
Shape = bsTopLine
end
@ -67,8 +68,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue
ParentColor = False
ParentFont = False
OnClick = lblTurboLinkClick
OnMouseMove = lblTurboLinkMouseMove
OnClick = lblLinkClick
OnMouseMove = lblLinkMouseMove
end
object lblHelp: TLabel
Cursor = crHandPoint
@ -80,8 +81,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue
ParentColor = False
ParentFont = False
OnClick = lblHelpClick
OnMouseMove = lblTurboLinkMouseMove
OnClick = lblLinkClick
OnMouseMove = lblLinkMouseMove
end
object CopyrightLabel: TLabel
Left = 7
@ -109,8 +110,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue
ParentColor = False
ParentFont = False
OnClick = lblGeneralDiscussionClick
OnMouseMove = lblTurboLinkMouseMove
OnClick = lblLinkClick
OnMouseMove = lblLinkMouseMove
end
object Label2: TLabel
Left = 168
@ -132,7 +133,7 @@ object frmAbout: TfrmAbout
Left = 152
Height = 58
Top = 40
Width = 401
Width = 395
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'Visual PlanIt was released under the Mozilla 1.1 license in January, 2003. The project is hosted on SourceForge at sourceforge.net/projects/tpvplanit.'
@ -1283,14 +1284,14 @@ object frmAbout: TfrmAbout
end
end
object OKButton: TButton
Left = 481
Left = 475
Height = 25
Top = 277
Width = 75
Anchors = [akTop, akRight]
Cancel = True
Caption = 'OK'
OnClick = OKButtonClick
ModalResult = 1
TabOrder = 1
end
end

92
components/tvplanit/source/vpabout.pas
View File

@ -34,7 +34,7 @@ interface
uses
{$IFDEF LCL}
LMessages,LCLProc,LCLType,LCLIntf,
LMessages, LCLProc, LCLType, LCLIntf,
{$ELSE}
Windows,Messages,
{$ENDIF}
@ -52,6 +52,9 @@ uses
Classes, SysUtils;
type
{ TfrmAbout }
TfrmAbout = class(TForm)
Bevel2: TBevel;
Panel1: TPanel;
@ -69,16 +72,12 @@ type
Label2: TLabel;
Label3: TLabel;
Label1: TLabel;
procedure OKButtonClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure lblTurboLinkClick(Sender: TObject);
procedure lblTurboLinkMouseMove(Sender: TObject; Shift: TShiftState; X,
procedure lblLinkMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure lblHelpClick(Sender: TObject);
procedure lblNewsSpecificClick(Sender: TObject);
procedure lblGeneralDiscussionClick(Sender: TObject);
procedure lblLinkClick(Sender: TObject);
private
{ Private declarations }
public
@ -121,7 +120,6 @@ function TVpAboutProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog, paReadOnly];
end;
{=====}
procedure TVpAboutProperty.Edit;
begin
@ -133,14 +131,9 @@ begin
end;
end;
end;
{=====}
{====================================================================}
procedure TfrmAbout.OKButtonClick(Sender : TObject);
begin
Close;
end;
{=====}
{ FrmAbout }
procedure TfrmAbout.FormActivate(Sender: TObject);
const
@ -161,72 +154,37 @@ begin
lblHelp.Cursor := crHandPoint;
lblGeneralDiscussion.Cursor := crHandPoint;
end;
{=====}
procedure TfrmAbout.lblTurboLinkClick(Sender: TObject);
procedure TfrmAbout.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
lblTurboLink.Font.Style := [];
end;
procedure TfrmAbout.lblLinkClick(Sender: TObject);
var
url: String;
begin
// if Sender = lblNewsSpecific then url := NEWS_SPECIFIC_URL else
if Sender = lblHelp then url := HELP_URL else
if Sender = lblGeneralDiscussion then url := GENERAL_DISCUSSION_URL else
if Sender = lblTurboLink then url := TURBO_LINK_URL else
exit;
{$IFDEF LCL}
if not OpenURL(TURBO_LINK_URL)
if not OpenUrl(url)
{$ELSE}
if ShellExecute(0, 'open', TURBO_LINK_URL, '', '', SW_SHOWNORMAL) <= 32
if ShellExecute(0, 'open', PChar(url), '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(RSBrowserError);
end;
{=====}
{=====}
{=====}
procedure TfrmAbout.lblTurboLinkMouseMove(Sender: TObject;
procedure TfrmAbout.lblLinkMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
TLabel(Sender).Font.Style := [fsUnderline];
end;
{=====}
procedure TfrmAbout.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
lblTurboLink.Font.Style := [];
end;
{=====}
procedure TfrmAbout.lblHelpClick(Sender: TObject);
begin
{$IFDEF LCL}
if not OpenUrl(HELP_URL)
{$ELSE}
if ShellExecute(0, 'open', HELP_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(RSBrowserError);
end;
{=====}
procedure TfrmAbout.lblNewsSpecificClick(Sender: TObject);
begin
{$IFDEF LCL}
if not OpenURL(NEWS_SPECIFIC_URL)
{$ELSE}
if ShellExecute(0, 'open', NEWS_SPECIFIC_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(RSBrowserError);
end;
{=====}
procedure TfrmAbout.lblGeneralDiscussionClick(Sender: TObject);
begin
{$IFDEF LCL}
if not OpenURL(GENERAL_DISCUSSION_URL)
{$ELSE}
if ShellExecute(0, 'open', GENERAL_DISCUSSION_URL, '', '', SW_SHOWNORMAL) <= 32
{$ENDIF}
then
ShowMessage(RSBrowserError);
end;
end.