From 4f72acf8cd5ca93853bccef0ff4134540fcde5e5 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 14 Jun 2016 11:19:09 +0000 Subject: [PATCH] tvplanit: Remove redundant code in AboutBox. Make sure all links are working. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4748 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/vpabout.lfm | 27 ++++---- components/tvplanit/source/vpabout.pas | 92 +++++++------------------- 2 files changed, 39 insertions(+), 80 deletions(-) diff --git a/components/tvplanit/source/vpabout.lfm b/components/tvplanit/source/vpabout.lfm index 2493118ed..1a0b37faf 100644 --- a/components/tvplanit/source/vpabout.lfm +++ b/components/tvplanit/source/vpabout.lfm @@ -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 diff --git a/components/tvplanit/source/vpabout.pas b/components/tvplanit/source/vpabout.pas index 3bf41d77d..da376cd72 100644 --- a/components/tvplanit/source/vpabout.pas +++ b/components/tvplanit/source/vpabout.pas @@ -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.