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 Left = 282
Height = 312 Height = 312
Top = 205 Top = 205
Width = 567 Width = 561
HorzScrollBar.Page = 470 HorzScrollBar.Page = 470
VertScrollBar.Page = 311 VertScrollBar.Page = 311
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'About Visual PlanIt' Caption = 'About Visual PlanIt'
ClientHeight = 312 ClientHeight = 312
ClientWidth = 567 ClientWidth = 561
OnActivate = FormActivate OnActivate = FormActivate
OnMouseMove = FormMouseMove OnMouseMove = FormMouseMove
Position = poScreenCenter Position = poScreenCenter
@ -17,15 +17,16 @@ object frmAbout: TfrmAbout
Left = 152 Left = 152
Height = 96 Height = 96
Top = 160 Top = 160
Width = 409 Width = 403
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
Shape = bsFrame Shape = bsFrame
OnMouseMove = lblLinkMouseMove
end end
object Bevel2: TBevel object Bevel2: TBevel
Left = 6 Left = 6
Height = 17 Height = 17
Top = 265 Top = 265
Width = 555 Width = 549
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
Shape = bsTopLine Shape = bsTopLine
end end
@ -67,8 +68,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue Font.Color = clBlue
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
OnClick = lblTurboLinkClick OnClick = lblLinkClick
OnMouseMove = lblTurboLinkMouseMove OnMouseMove = lblLinkMouseMove
end end
object lblHelp: TLabel object lblHelp: TLabel
Cursor = crHandPoint Cursor = crHandPoint
@ -80,8 +81,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue Font.Color = clBlue
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
OnClick = lblHelpClick OnClick = lblLinkClick
OnMouseMove = lblTurboLinkMouseMove OnMouseMove = lblLinkMouseMove
end end
object CopyrightLabel: TLabel object CopyrightLabel: TLabel
Left = 7 Left = 7
@ -109,8 +110,8 @@ object frmAbout: TfrmAbout
Font.Color = clBlue Font.Color = clBlue
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
OnClick = lblGeneralDiscussionClick OnClick = lblLinkClick
OnMouseMove = lblTurboLinkMouseMove OnMouseMove = lblLinkMouseMove
end end
object Label2: TLabel object Label2: TLabel
Left = 168 Left = 168
@ -132,7 +133,7 @@ object frmAbout: TfrmAbout
Left = 152 Left = 152
Height = 58 Height = 58
Top = 40 Top = 40
Width = 401 Width = 395
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = False 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.' 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
end end
object OKButton: TButton object OKButton: TButton
Left = 481 Left = 475
Height = 25 Height = 25
Top = 277 Top = 277
Width = 75 Width = 75
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Cancel = True Cancel = True
Caption = 'OK' Caption = 'OK'
OnClick = OKButtonClick ModalResult = 1
TabOrder = 1 TabOrder = 1
end end
end end

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

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